***********************************************************
       TITL 'RXB 2015'
***********************************************************
       GROM >C000
***********************************************************
       TITL 'EQUATES ALCS-359'
***********************************************************
FSLOC  EQU  >2002             Free Start LOCation in ERAM
*                             Free end must follow it.
INITF  EQU  >2006             INIT flag address INIT has be
*                             called if ERAM (INITF)=>AA55
* Free end initialized to >4000, (>FFF8 for debugger)
* Free start is initialized to the first useable memory
*  location for assembly language code
CPUBAS EQU  >A040             Expansion RAM base
***********************************************************
*           GROM ADDRESSES
***********************************************************
* GROM >6000
MZMSG  EQU  >6038             Start of message area
MSGFST EQU  >6040
MSG10  EQU  >6065
MSG14  EQU  >6076
MSG16  EQU  >6083
MSG17  EQU  >609C
MSG19  EQU  >60AD
MSG24  EQU  >60BB
MSG25  EQU  >60D2
MSG28  EQU  >60E4
MSG34  EQU  >60F9
MSG36  EQU  >6110
MSG39  EQU  >611C
MSG40  EQU  >6128
MSG43  EQU  >6137
MSG44  EQU  >6148
MSG47  EQU  >6159
MSG48  EQU  >616F
MSG49  EQU  >6189
MSG51  EQU  >6198
MSG54  EQU  >61AD
MSG57  EQU  >61BE
MSG60  EQU  >61CC
MSG61  EQU  >61DB
MSG67  EQU  >61EB
MSG69  EQU  >61FA
MSG70  EQU  >6215
MSG74  EQU  >622D
MSG78  EQU  >623A
MSG79  EQU  >624D
MSG81  EQU  >6257
MSG83  EQU  >626F
MSG84  EQU  >627B
MSG97  EQU  >6286
MSG109 EQU  >629B
MSG130 EQU  >62A6
MSG135 EQU  >62B0
MSG62  EQU  >62C5
MSGCIS EQU  >630A
MSGCF  EQU  >6319
MSG56  EQU  >6324
TOPLEV EQU  >6372             RXB PATCH for XBPGM
SZNEW  EQU  >63A5             RXB PATCH for NEW
TOPL15 EQU  >63DD             * Return from OLD or SAVE
TOPL42 EQU  >6433
TOPL55 EQU  >6462
ILLST  EQU  >64EF
SZSIZE EQU  >65C9             RXB PATCH for SIZE
EDITLN EQU  >66CF             * Edit a line into a program
READL3 EQU  >6A8A
G6D78  EQU  >6D78             * GKXB ERR routine
ERPRNT EQU  >6E0E
ERPNT5 EQU  >6E1B
DISO   EQU  >6FBA
* GROM >8000
GRMLST EQU  >802A
CHARS  EQU  >9CEA             GROM ADDRESS CHAR DEFINITIONS
ALCEND EQU  >9800             RXB moved INIT here
* GROM >A000
ASC    EQU  >A00A
LNKRTN EQU  >A01C
MZSUB  EQU  >AE00             Module SPRITE branch table ad
* GROM >E000
GE025  EQU  >E025             RXB PATCH for EA
***********************************************************
*    EQUATES FOR ROUTINES FROM OTHER GROM SECTIONS
INITPG EQU  >6014             Initialize program space
SPRINT EQU  >6016             Initialize sprites
TOPL10 EQU  >601A             Return to main and re-init
CHRTAB EQU  >601C             Load default character set
SZRUN  EQU  >601E
KILSYM EQU  >6022             KILL SYMBOL TABLE ROUTINE
AUTO1  EQU  >602E             Get arguments for LIST comman
TOPL02 EQU  >6030             RTN address for failing AUTOL
GRSUB1 EQU  >6034             Read data (2 bytes) from ERAM
GWSUB  EQU  >6036             Write a few bytes of data to
MSGBRK EQU  >6048             * BREAKPOINT
MSGTA  EQU  >6053             Message "try again"
LLIST  EQU  >6A74             List a line
READLN EQU  >6A76             Read a line from keyboard
CHKEND EQU  >6A78             Check end of statement
ENTER  EQU  >6A7E
ENT09  EQU  >6A80
WARNZZ EQU  >6A82             WARNING MESSAGE ROUTINE
ERRZZ  EQU  >6A84             ERROR MESSAGE ROUTINE
ERRZ   EQU  >6A84             ERRor routine
READL1 EQU  >6A86             Read a line from keyboard
DISPL1 EQU  >8000
DELET  EQU  >8002
PRINT  EQU  >8004
INPUT  EQU  >8006
OPEN   EQU  >8008
CLOSE  EQU  >800A
RESTOR EQU  >800C
NREAD  EQU  >800E
CLSALL EQU  >8012
EOF    EQU  >801C
ACCEPT EQU  >801E
SRDATA EQU  >8020
REC    EQU  >8022
GRSUB2 EQU  >802C
GRSUB3 EQU  >802E
LINPUT EQU  >8030
CONVER EQU  >A012             CONVERT WITH WARNING
CPL    EQU  >0010             Call Program Link
RPL    EQU  >0012             Return Program Link
GRINT  EQU  >0022             Greatest integer
ATNZZ  EQU  >0032             Arctangent routine
***********************************************************
*    Equates for routine in MONITOR
DSR    EQU  >10               CALL DEVICE SERVICE ROUTINE
TONE1  EQU  >34               ACCEPT TONE
TONE2  EQU  >36               BAD TONE
CHAR2Z EQU  >18               CHARACTER TABLE ADDRESS small
CHAR3Z EQU  >4A               CHARACTER TABLE ADDRESS
***********************************************************
*    Equates for XMLs
SYNCHK EQU  >00               SYNCHK XML selector
FILSPC EQU  >01               Fill-space utility
PARCOM EQU  >01               PARse to a COMma selector
CSTRIN EQU  >02               Copy-string utility
RANGE  EQU  >02               RANGE selector
SEETWO EQU  >03               SEETWO XML selector
FADD   EQU  >06               Floating ADD
FMUL   EQU  >08               Floating MULtiply
FDIV   EQU  >09               Floating DIVide
FCOMP  EQU  >0A               Floating COMPare
SADD   EQU  >0B               Stack ADD
SSUB   EQU  >0C               Stack SUBtract
CSNUM  EQU  >10               Convert String to Number
CFI    EQU  >12               Convert to two byte integer
FLTINT EQU  >12               Convert floating to integer
ALSUP  EQU  >20               XML to user AssembLy SUBrouti
COMPCT EQU  >70               PREFORM A GARBAGE COLLECTION
GETSTR EQU  >71               SYSTEM GET STRING
MEMCHK EQU  >72               MEMORY check routine: VDP
XCNS   EQU  >73               Convert number to string
* Warning Defualt changed in >0159
PARSE  EQU  >74               Parse a value
CONT   EQU  >75               Continue parsing
EXECG  EQU  >76               Execute a XB stmt or program
VPUSH  EQU  >77               Push on value stack
VPOP   EQU  >78               Pop off value stack
PGMCHR EQU  >79               GET PROGRAM CHARACTER
SYM    EQU  >7A               Find SYMBOL entry
SMB    EQU  >7B               Find symbol table entry
ASSGNV EQU  >7C               Assign VARIABLE
SCHSYM EQU  >7D               Search symbol table
SPEED  EQU  >7E               SPEED UP XML
CRUNCH EQU  >7F               Crunch an input line
CIF    EQU  >80               Convert INTEGER to FLOATING P
RTNB   EQU  >82               Return
SCROLL EQU  >83               SCROLL THE SCREEN
IO     EQU  >84               IO utility (KW table search)
GREAD  EQU  >85               READ DATA FROM ERAM
GWRITE EQU  >86               WRITE DATA TO ERAM
DELREP EQU  >87               REMOVE CONTENT FROM VDP/ERAM
MVDN   EQU  >88               MOVE DATA IN VDP/ERAM
MVUP   EQU  >89               MOVE DATA IN VDP/ERAM
VGWITE EQU  >8A               MOVE DATA FROM VDP TO ERAM
GVWITE EQU  >8B               WRITE DATA FROM GRAM TO VRAM
GREAD1 EQU  >8C               READ DATA FROM ERAM
GDTECT EQU  >8E               ERAM DETECT&ROM PAGE 1 ENABLE
SCNSMT EQU  >8F               SCAN STATEMENT FOR PRESCAN
***********************************************************
*    Temporary workspaces in EDIT
CPUOFF EQU  >8300             CPU RAM OFFSET
VAR0   EQU  >8300            TEMPORARY
SP00   EQU  >8300            SPRITE value
PTFBSL EQU  >8300            Ptr to 1st byte in SPEAK list
PHLEN  EQU  >8300            PHrom data LENgth
VARV   EQU  >8301            TEMPORARY
PHRADD EQU  >8301            PHRom ADDress
ACCUM  EQU  >8302            # OF BYTES ACCUMULATOR (4 BYTE
STPT   EQU  >8302            TWO BYTES
MNUM   EQU  >8302            Ussually a counter
AAA1   EQU  >8302
SP02   EQU  >8302            SPRITE value
PTLBSL EQU  >8302            Ptr to last byte in SPEAK list
CHKSUM EQU  >8302            Check sum word
PC     EQU  >8304            Address in ERAM to load next v
VARY   EQU  >8304
PABPTR EQU  >8304            Pointer to current PAB
SP04   EQU  >8304            SPRITE value
PTEBSL EQU  >8304            Ptr to end byte in SPEAK list
* NOTE: PTEBSL points to the end of the temporary speak lis
*       whereas PTLBSL points to the last byte actually use
*       i.e.    PTFBSL <= PTLBSL <= PTEBSL
VARY2  EQU  >8306            Use in MVDN only
DFLTLM EQU  >8306            Default array limit (10)
CCPPTR EQU  >8306            OFFSET WITHIN RECORED (1)
*                             or Pointer to current column
SP06   EQU  >8306            SPRITE value
PTFCIS EQU  >8306            Ptr to 1st character in string
OFFADD EQU  >8306            OFFADD of relocatable programs
*                             loaded into ERAM.
RECLEN EQU  >8307            LENGTH OF CURRENT RECORD (1)
CCPADR EQU  >8308            RAM address of current refs
*                             or Actual buffer address or c
VARC   EQU  >8308
CCPADD EQU  >8308            RAM address of current color
CCC1   EQU  >8308
SPSAL  EQU  >8308            Location of sprite attribute l
PTCCIS EQU  >8308            Ptr to current character in st
FRESTA EQU  >8308            Start of free memory in ERAM
*                         the end of the reloacatable progr
*                         (start of next program) is stored
*                         in FRESTA once a "0" tag is found
FREEND EQU  >830A            End of free memory in ERAM -
*                         points to 1st character of last
*                         entry into routine name table.
*                         (must follow FRESTA!!!)
CALIST EQU  >830A            Call list for resolving refs
RAMPTR EQU  >830A            Pointer for crunching
STADDR EQU  >830A            Start address - usually for co
SPTMP  EQU  >830A            Temporary variable
PTLCIS EQU  >830A            Ptr to last character in strin
VAR2   EQU  >830B
BYTES  EQU  >830C            BYTE COUNTER
*                             or String length for GETSTR
NMPTR  EQU  >830C            Pointer save for pscan
BBB1   EQU  >830C
PTFCIP EQU  >830C            Ptr to 1st character in phrase
BUFPNT EQU  >830E            I/O buffer pointer
CHSAV  EQU  >830E
CURINC EQU  >830E            Increment for auto-num mode
VAR4   EQU  >830E
PTCCIP EQU  >830E            Ptr to current character in ph
TOPSTK EQU  >8310            Top of data stack pointer
VAR5   EQU  >8310            VAR5 through VAR5+3 used in RA
PTLCIP EQU  >8310            Ptr to last character in phras
TAG    EQU  >8310            TAG FIELD
OLDS   EQU  >8310            FLAG BITS
TBLPTR EQU  >8310            Table pointer (CHARPAT)
FIELD  EQU  >8311            Value after TAG field, 4 bytes
*                             (must follow TAG!!!)
VAR6   EQU  >8311
LINUM  EQU  >8312            Used to determine end of scan
PTFBPH EQU  >8312            Ptr to 1st byte in PHrom
VAR7   EQU  >8312            Used in CHARLY
COUNT  EQU  >8312            FLAG BITS
STRPTR EQU  >8312            String pointer (CHARPAT)
NMLEN  EQU  >8314            Current line for auto-num
CURLIN EQU  >8314            Current line for auto-num
*                             or Starting line number for L
PTCCPH EQU  >8314            Ptr to current byte in PHrom
VAR9   EQU  >8314            Used in CHARLY
STORE  EQU  >8314            FLAG BITS
INDEXC EQU  >8315            Byte index for computing check
VARB   EQU  >8316            Source address for XML MVUP
XFLAG  EQU  >8316            SCAN FLAG-BITS USED AS BELOW
PTLCPH EQU  >8316            Ptr to last byte in PHrom
TEMP   EQU  >8316            FLAG BITS
DFLAG  EQU  >8316            Disk/Hard FLAG
DEVNUM EQU  >8317            DEVice NUMber for Hard drive
DSRFLG EQU  >8317            INTERNAL =60, EXTERNAL =0 (1)
OPTFLG EQU  >8317            Option flag byte during OPEN
FORNET EQU  >8317            Nesting level of for/next
FNUM   EQU  >8317            Current file number for search
***********************************************************
*    Permanent workspace variables
STRSP  EQU  >8318            String space begining
STREND EQU  >831A            String space ending
SREF   EQU  >831C            Temporary string pointer
SMTSRT EQU  >831E            Start of current statement
VARW   EQU  >8320            Screen address (CURSOR)
ERRCOD EQU  >8322            Return error code from ALC
STVSPT EQU  >8324            Value-stack base
RTNG   EQU  >8326            Return vector from 9900 code
NUDTAB EQU  >8328            Start of NUD table
VARA   EQU  >832A            Ending display location
PGMPTR EQU  >832C            Program text pointer (TOKEN)
EXTRAM EQU  >832E            Line number table pointer
STLN   EQU  >8330            Start of line number table
ENLN   EQU  >8332            End of line number table
DATA   EQU  >8334            Data pointer for READ
LNBUF  EQU  >8336            Line table pointer for READ
INTRIN EQU  >8338            Add of intrinsic poly constant
SUBTAB EQU  >833A            Subprogram symbol table
IOSTRT EQU  >833C            PAB list/Start of I/O chain
SYMTAB EQU  >833E            Symbol table pointer
FREPTR EQU  >8340            Free space pointer
CHAT   EQU  >8342            Current charater/token
BASE   EQU  >8343            OPTION BASE value
PRGFLG EQU  >8344            Program/imperative flag
FLAG   EQU  >8345            General 8-bit flag
BUFLEV EQU  >8346            Crunch-buffer destruction leve
LSUBP  EQU  >8348            Last subprogram block on stack
* FAC  EQU  >834A            Floating-point ACcurmulator
CCHAR  EQU  >834A            Current character
FAC1   EQU  FAC+1
SPLFLG EQU  >834B            SPelL out phrase FLaG
FAC2   EQU  FAC+2
AAA    EQU  FAC+2
TOTTIM EQU  >834C            TOTal wait TIMe
* NOTE: DATAD must follow immediately after TOTTIM. The
*       routine STDATA is counting on this fact!
FAC3   EQU  FAC+3
DATAAD EQU  >834D            Speech DATA ADdress
FAC4   EQU  FAC+4
CCC    EQU  FAC+4
FFF    EQU  FAC+4
FAC5   EQU  FAC+5
PTLCIL EQU  >834F            Pointer To Last Character In L
FAC6   EQU  FAC+6
BBB    EQU  FAC+6
EEE    EQU  FAC+6
FAC7   EQU  FAC+7
TIMLEN EQU  >8351             TIMe LENgth of timing charact
FAC8   EQU  FAC+8
PHADDR EQU  >8352             PHrom ADDRess
FAC9   EQU  FAC+9
FAC10  EQU  FAC+10
DDD1   EQU  FAC+10
TEMP1  EQU  >8354            TEMPorary CPU location 1
FAC11  EQU  FAC+11
FAC12  EQU  FAC+12
FFF1   EQU  FAC+12
TEMP2  EQU  >8356            TEMPorary CPU location 2
FAC13  EQU  FAC+13
FAC14  EQU  FAC+14
EEE1   EQU  FAC+14
READ   EQU  >8358            Address of speech peripheral
*                             READ byte interface
FAC15  EQU  FAC+15
FAC16  EQU  FAC+16
WRITE  EQU  >835A            Address of speech peripheral
*                             WRITE byte interface
FAC17  EQU  FAC+17
* ARG  EQU  >835C            Floating-point ARGument
ARG1   EQU  ARG+1
PHDATA EQU  >835D            PHrom DATA
ARG2   EQU  ARG+2
PTCBED EQU  >835E            Ptr To Current Byte Ext Data
INDEX  EQU  >835E            Label or program ID - 8 bytes
ARG3   EQU  ARG+3
ARG4   EQU  ARG+4
LENCST EQU  >8360            LEN of Current ext data STring
ARG5   EQU  ARG+5
ARG6   EQU  ARG+6
LENWST EQU  >8362            LEN of Whole ext data STring
STRLEN EQU  >8364            STRing LENgth
TEMP4  EQU  >8364
TEMP5  EQU  >8366
* NOTE: BYTE1, BYTE2, and BYTE3 must be in consecutive memo
*       locations, and in the following order for SPGET to
*       work!
BYTE1  EQU  >8366            BYTE 1
BYTE2  EQU  >8367            BYTE 2
BYTE3  EQU  >8368            BYTE 3
TEMP6  EQU  >8368
SPKSTS EQU  >8369            SPeaK StaTus
FPERAD EQU  >836C            Value stack pointer
* VSPTR  EQU  >836E          Value stack pointer
***********************************************************
*    GPL Status Block
STACK  EQU  >8372             STACK FOR DATA
SUBSTK EQU  >8373             SUBROUTINE STACK
KEYBD  EQU  >8374             KEYBOARD SELCTION
RKEY   EQU  >8375             KEY CODE
SIGNZ  EQU  >8375
EXPZ   EQU  >8376             Exponent in floating-point
JOYY   EQU  >8376             JOYSTICK Y POSITION
JOYX   EQU  >8377             JOYSTICK X POSITION
RANDOM EQU  >8378             RANDOM NUMBER GENERATOR
TIMER  EQU  >8379             TIMING REGISTER
MOTION EQU  >837A             NUMBER OF MOVING SPRITES
VDPSTS EQU  >837B             VDP STATUS REGISTER
VDPSTT EQU  >837B             VDP STATUS REGISTER
ERCODE EQU  >837C             STATUS REGISTER
CB     EQU  >837D             Character Buffer
***********************************************************
RAMTOP EQU  >8384            Highest address in ERAM
*                             = 0 if ERAM not present
RAMFRE EQU  >8386            Free pointer in the ERAM
RSTK   EQU  >8388            Subroutine stack base
*                             (Starts at >8A)
RAMFLG EQU  >8389            ERAM flag
GRAMFL EQU  >8389            GRAM / VDP flag
STKMIN EQU  >83AF            Base of data stack
STKMAX EQU  >83BD            Top of data stack
GKFLAG EQU  >83C2            GKXB flag for PEEK/LOAD VDP/GR
PRTNFN EQU  >83CE            Sound - previous tone finished
***********************************************************
*    VDP addresses
SCRNBS EQU  >02E0             Screen base addr for last lin
NLNADD EQU  >02E2             New LiNe ADDress
ENDSCR EQU  >02FE             END of SCReen address
SPRSAL EQU  >0300             Sprite attribute list
LODFLG EQU  >0371             Auto-boot needed flag
START  EQU  >0372             Line to start execution at
* Temporary
NOTONE EQU  >0374             NO-TONE for SIZE in ACCEPT us
*                              in FLMGRS (4 bytes used)
SYMBOL EQU  >0376             Saved symbol table pointer
ONECHR EQU  >0378             Used for CHRZ
VRMSND EQU  >0379             Sound blocks
SPGMPT EQU  >0382             Saved PGMPTR for continue
SBUFLV EQU  >0384             Saved BUFLEV for contiue
SEXTRM EQU  >0386             Saved EXTRAM for continue
SAVEVP EQU  >0388             Saved VSPRT for continue
ERRLN  EQU  >038A             On-error line pointer
BUFSRT EQU  >038C             Edit recall start addr (VARW)
BUFEND EQU  >038E             Edit recall end addr (VARA)
CSNTMP EQU  >0390             Use as temporary stored place
*                          or CSN TEMPORARY FOR FAC12
TABSAV EQU  >0392             Saved main symbol table ponte
AUTTMP EQU  >0394             AUTOLD TEMPORARY IN SIDE ERRZ
SLSUBP EQU  >0396             Saved LSUBP for continue
SFLAG  EQU  >0398             Saved on-warning/break bits
SSTEMP EQU  >039A             To save subprogram program ta
SSTMP2 EQU  >039C             Same as above. Used in SUBPRO
MRGPAB EQU  >039E             MERGEd temporary for pab ptr
RNDX2  EQU  >03A0             Random number generator seed
RNDX1  EQU  >03A5             Random number generator seed
INPUTP EQU  >03AA             INPUT TEMPORARY FOR PTR TO PR
SPNUM  EQU  >03AA             Sprite number temporary, also
*                              in INPUTP in FLMGR
ACCVRW EQU  >03AC             Temoporary used in ERRZZ, als
*                              used in FLMGRS
*                             or temporary for @VARW, @VARA
ACCVRA EQU  >03AE             TRY AGAIN
VALIDP EQU  >03B0             Use as two values passing fro
*                          or PTR TO STANDARD STRING IN VAL
VALIDL EQU  >03B2             VALIDATE code to READL1
*                          or Length of string in validate
SIZCCP EQU  >03B4             SIZE TEMPORARY FOR CCPADR
SIZREC EQU  >03B6             SIZE TEMPORARY FOR RECLEN
*                            Also used as temporary in RELO
*----------------------------------------------------------
* Added 6/8/81 for NOPSCAN feature
PSCFG  EQU  >03B7
*----------------------------------------------------------
ACCTRY EQU  >03B7             ACCEPT "TRY AGAIN" FLAG
SIZXPT EQU  >03B8             Save XPT in SIZE when "try ag
SAPROT EQU  >03B9             PROTECTION flag in SAVE
CSNTP1 EQU  >03BA             CSN TEMPORARY FOR FAC10
*----------------------------------------------------------
*    Flag 0:  99/4  console, 5/29/81
*         1:  99/4A console
CONFLG EQU  >03BB
*----------------------------------------------------------
OLDTOP EQU  >03BC             Temporary used in ERRZZ, also
*                          or Old top of memory for RELOCA
CPTEMP EQU  >03BC             CCPPTR, RECLEN temp in INPUT
NEWTOP EQU  >03BE             New top of memory for RELOCA
VROAZ  EQU  >03C0             Temporary roll-out area
SPRVB  EQU  >0780             Sprite velocity block.
CRNBUF EQU  >0820             CRuNch BUFfer address
CRNEND EQU  >08BE             CRuNch buffer END
RECBUF EQU  >08C0             Edit RECall BUFfer
VRAMVS EQU  >0958             Default base of value stack
***********************************************************
*    IMMEDITATE VALUES
NUMBR  EQU  >00               NUMERIC validate
LISTZ  EQU  >02
X2     EQU  >03
OLDZ   EQU  >05
RESEQZ EQU  >06
SAVEZ  EQU  >07
MERGEZ EQU  >08
DWNARR EQU  >0A
UPARR  EQU  >0B
CHRTN  EQU  >0D
BKGD   EQU  >20               BACKGROUND CHARACTER
OFFSET EQU  >60               OFFSET FOR VIDEO TABLES
STRVAL EQU  >65               Value in accum. is string val
STRING EQU  >65               String ID # for FAC
***********************************************************
* Editting command equates & keys or symbols
BREAK  EQU  >02               Break key
DLETE  EQU  >03               Delete key
INSRT  EQU  >04               Insert key
RECALL EQU  >06               Edit-buffer recall
CLRLN  EQU  >07               Clear-line key
BACK   EQU  >08               Back-space key
FORW   EQU  >09               Forward-space key
DOWN   EQU  >0A               Down-arrow key
UPMV   EQU  >0B               Up-arrow key
VWIDTH EQU  >1C               Screen width (PRINT)
SPACE  EQU  >20               Space key
QUOTE  EQU  >22               "
NUMBER EQU  >23               #
DOLLAR EQU  >24               $
CURSOR EQU  >1E+OFFSET        CURSOR
EDGECH EQU  >1F+OFFSET        EDGE character
PLUS   EQU  >2B               +
COMMAT EQU  >2C               ,
MINUS  EQU  >2D               -
HYPEN  EQU  >2D               +
PERIOD EQU  >2E               .
ZERO   EQU  >30               0
NINE   EQU  >39               9
COLON  EQU  >3A               :
SEMICO EQU  >3B               ;
LESS   EQU  >3C               <
GREAT  EQU  >3E               >
A      EQU  >41               A
F      EQU  >46               F
***********************************************************
* PAB offset
FLG    EQU  1                 FLAG BYTE ENTRY
BUF    EQU  2                 BUFFER ENTRY
LEN    EQU  4                 RECORD LENGTH ENTRY
CHRCNT EQU  5                 CHARACTER COUNT
RNM    EQU  6                 RECORD NUMBER
SCR    EQU  8                 SCREEN OFFSET ENTRY
NLEN   EQU  9                 NAME LENGTH
PABLEN EQU  10                ACTUAL PAB LENGTH
***********************************************************
*    BASIC TOKEN TABLE
*      EQU  >80               spare token
ELSEZ  EQU  >81               ELSE
SSEPZ  EQU  >82               ::
TREMZ  EQU  >83               $
IFZ    EQU  >84               IF
GOZ    EQU  >85               GO
GOTOZ  EQU  >86               GOTO
GOSUBZ EQU  >87               GOSUB
RETURZ EQU  >88               RETURN
DEFZ   EQU  >89               DEF
DIMZ   EQU  >8A               DIM
ENDZ   EQU  >8B               END
FORZ   EQU  >8C               FOR
LETZ   EQU  >8D               LET
BREAKZ EQU  >8E               BREAK
UNBREZ EQU  >8F               UNBREAK
TRACEZ EQU  >90               TRACE
UNTRAZ EQU  >91               UNTRACE
INPUTZ EQU  >92               INPUT
DATAZ  EQU  >93               DATA
RESTOZ EQU  >94               RESTORE
RANDOZ EQU  >95               RANDOMIZE
NEXTZ  EQU  >96               NEXT
READZ  EQU  >97               READ
STOPZ  EQU  >98               STOP
DELETZ EQU  >99               DELETE
REMZ   EQU  >9A               REM
ONZ    EQU  >9B               ON
PRINTZ EQU  >9C               PRINT
CALLZ  EQU  >9D               CALL
OPTIOZ EQU  >9E               OPTION
OPENZ  EQU  >9F               OPEN
CLOSEZ EQU  >A0               CLOSE
SUBZ   EQU  >A1               SUB
DISPLZ EQU  >A2               DISPLAY
IMAGEZ EQU  >A3               IMAGE
ACCEPZ EQU  >A4               ACCEPT
ERRORZ EQU  >A5               ERROR
WARNZ  EQU  >A6               WARNING
SUBXTZ EQU  >A7               SUBEXIT
SUBNDZ EQU  >A8               SUBEND
RUNZ   EQU  >A9               RUN
LINPUZ EQU  >AA               LINPUT
*      EQU  >AB               spare token (LIBRARY)
*      EQU  >AC               spare token (REAL)
*      EQU  >AD               spare token (INTEGER)
*      EQU  >AE               spare token (SCRATCH)
*      EQU  >AF               spare token
THENZ  EQU  >B0               THEN
TOZ    EQU  >B1               TO
STEPZ  EQU  >B2               STEP
COMMAZ EQU  >B3               ,
SEMICZ EQU  >B4               ;
COLONZ EQU  >B5               :
RPARZ  EQU  >B6               )
LPARZ  EQU  >B7               (
CONCZ  EQU  >B8               &          (CONCATENATE)
*      EQU  >B9               spare token
ORZ    EQU  >BA               OR
ANDZ   EQU  >BB               AND
XORZ   EQU  >BC               XOR
NOTZ   EQU  >BD               NOT
EQUALZ EQU  >BE               =
LESSZ  EQU  >BF               <
GREATZ EQU  >C0               >
PLUSZ  EQU  >C1               +
MINUSZ EQU  >C2               -
MULTZ  EQU  >C3               *
DIVIZ  EQU  >C4               /
CIRCUZ EQU  >C5               ^
*      EQU  >C6               spare token
STRINZ EQU  >C7               QUOTED STRING
UNQSTZ EQU  >C8               UNQUOTED STRING
NUMZ   EQU  >C8               ALSO NUMERICAL STRING
NUMCOZ EQU  >C8               ALSO UNQUOTED STRING
LNZ    EQU  >C9               LINE NUMBER CONSTANT
EOFZ   EQU  >CA               EOF
ABSZ   EQU  >CB               ABS
ATNZ   EQU  >CC               ATN
COSZ   EQU  >CD               COS
EXPZZ  EQU  >CE               EXP
INTZ   EQU  >CF               INT
LOGZ   EQU  >D0               LOG
SGNZZ  EQU  >D1               SGN
SINZ   EQU  >D2               SIN
SQRZ   EQU  >D3               SQR
TANZ   EQU  >D4               TAN
LENZ   EQU  >D5               LEN
CHRZZ  EQU  >D6               CHR$
RNDZ   EQU  >D7               RND
SEGZZ  EQU  >D8               SEG$
POSZ   EQU  >D9               POS
VALZ   EQU  >DA               VAL
STRZZ  EQU  >DB               STR$
ASCZ   EQU  >DC               ASC
PIZ    EQU  >DD               PI
RECZ   EQU  >DE               REC
MAXZ   EQU  >DF               MAX
MINZ   EQU  >E0               MIN
RPTZZ  EQU  >E1               RPT$
* RXB PATCH CODE 
*      EQU  >E2               unused
RANZ   EQU  >E2               RAN
*      EQU  >E2               unused
*      EQU  >E3               unused
*      EQU  >E4               unused
*      EQU  >E5               unused
*      EQU  >E6               unused
*      EQU  >E7               unused
NUMERZ EQU  >E8               NUMERIC
DIGITZ EQU  >E9               DIGIT
UALPHZ EQU  >EA               UALPHA
SIZEZ  EQU  >EB               SIZE
ALLZ   EQU  >EC               ALL
USINGZ EQU  >ED               USING
BEEPZ  EQU  >EE               BEEP
ERASEZ EQU  >EF               ERASE
ATZ    EQU  >F0               AT
BASEZ  EQU  >F1               BASE
*      EQU  >F2               spare token (TEMPORARY)
VARIAZ EQU  >F3               VARIABLE
RELATZ EQU  >F4               RELATIVE
INTERZ EQU  >F5               INTERNAL
SEQUEZ EQU  >F6               SEQUENTIAL
OUTPUZ EQU  >F7               OUTPUT
UPDATZ EQU  >F8               UPDATE
APPENZ EQU  >F9               APPEND
FIXEDZ EQU  >FA               FIXED
PERMAZ EQU  >FB               PERMANENT
TABZ   EQU  >FC               TAB
NUMBEZ EQU  >FD               #
VALIDZ EQU  >FE               VALIDATE
*      EQU  >FF               ILLEGAL VALUE
***********************************************************
* ASSEMBLY LANGUAGE SUPPORT FOR 99/4
*
* LOAD, INIT, PEEK, LINK, CHARPAT      JDH  08/21/80
***********************************************************
* FORMAT FOR LOAD:
*  CALL LOAD open load-directive (comma load-directive)
*            close
*    load-directive = file-name / address (comma data)
*                     (null / file-name)
*    file-name      = string-expression
*    address        = numeric-expression
*    data           = numeric-expression
*
*  FILE TYPE = FIXED 80, DISPLAY , SEQUENTIAL FILE
*
* FUNCTION:
*  LOADS ASSEMBLY LANGUAGE CODE INTO EXPANSION RAM
*  ADDRESSES: >2000 - >>3FFF RELOCATING
*  RELOCATABLE CODE INTO AVAILABLE MEMORY, ABSOLUTE CODE
*  IS LOADED
*  INTO ITS ABSOLUTE ADDRESS, ENTRY POINTS ARE DEFINED BY
*  'DEF' STATEMENTS, AND ARE LOADED INTO HIGH END OF ERAM
*
*  RELOACATABLE OR ABSOLUTE CODE MAY BE STORED ON A FILE
*  9900 OBJECT CODE FORMAT.
*   VALID TAGS = 0, 5, 6, 7, 9, A, B, C, F,:
*         TAGS 1, 2, I, M, ARE IGNORED
*  THE SYMT OPTION IS NOT SUPPORTED.
*  ABSOLUTE CODE MAY BE LOADED DIRECTLY FROM PROGRAM
*  BY SPECIFYING AN ADDRESS INSTEAD OF A FILE NAME,
*  FOLLOWED BY THE DATA TO BE LOADED (WHICH IS PUT IN THE
*   RANGE 0 to 255
*  THE RANGE OF THE ADDRESS OR DATA IS LIMITED TO
*   32767 to -32768
*  MULTIPLE DIRECT LOADS CAN BE IN THE SAME LOAD COMMAND
*  PROVIDED THEY ARE SEPARATED BY EITHER A FILENAME OR A
*   NULL STRING.
*
*  MVUP WAS USED TO TRANSFER DATA FROM CPU RAM TO ERAM
*  SINCE IT WAS NOT KNOWN AT FIRST THAT THE MOVE
*  INSTRUCTION COULD TRANSFER FROM CPU RAM TO ERAM
*   (PROVIDED THAT >8300 IS SUBTRACTED FROM THE ADDRESSES)
***********************************************************
******************* LINKAGE AND HEADER ********************
       BYTE >AA
       BYTE 12,0,0
       BYTE 0,0,0,0,0,0
       DATA 0
       BYTE 0,0,0,0
LINK1  DATA LINK2
       STRI 'LINK'
       DATA LINKIT
LINK2  DATA LINK3
       STRI 'LOAD'
       DATA LOAD
LINK3  DATA LINK4
       STRI 'INIT'
       DATA INIT
* GKXB new entry point for PEEK
LINK4  DATA LINK5
       STRI 'PEEK'
       DATA GKPEEK
* GKXB new subprograms
LINK5  DATA QTON
       STRI 'CHARPAT'
       DATA GETCHR
* LOAD - LDP1 - LDP4 - LDP5
** CHKSUM is also used as a flag to test if a file has been
** opened (so that it gets closed)
** it is initialized to >0001 and will be changed to some
** other value if a file is used
LOAD   DST  >0001,@CHKSUM     {INITIALIZE FILE FLAG}
* GKXB Change load routine. Delete check for INIT
*      add to clear flag bits.
       CALL GKLOAD
GC047  CEQ  LPARZ,@CHAT       SYNTAX ERROR if no "("
       BR   ERRSY1
       XML  PGMCHR            Skip over
* MAIN PARESE LOOP *
* Check for file-name or address
LDP1   XML  PARSE
       BYTE RPARZ           * PARSE up to ")" or ","
       CEQ  STRING,@FAC2      Process file name
       BS   LDP2
* Otherwise it is an address
* Convert address to integer, save in @PC
       XML  CFI               Convert FAC to integer
       CEQ  3,@FAC10          Check for overflow
       BS   ERRN01
       DST  @FAC,@PC          Save in ERAM location pointer
* Check for "," if there then data should folow
*  else end of load statement, goto LDP5
LDP4   CEQ  COMMAZ,@CHAT
       BR   LDP5
* DATA follows or a STRING if no more data
       XML  PGMCHR            Skip ","
       XML  PARSE             Get data value or string if
*                              end of data
       BYTE RPARZ           * Parse up to ")" or ","
       CEQ  STRING,@FAC2      No more data
       BS   LDP2
* FAC contains a numeric
       XML  CFI               FAC to INTEGER
       CEQ  3,@FAC10          Check for overflow
       BS   ERRN01
* GKXB Code for CPU write moved to LOADDT. Add code to
*      check VDP or GRAM bits and write to VDP.
       CLOG >08,@GKFLAG       Check VDP bit
       BS   LDGRAM            No, check GRAM bit
       ST   @FAC1,V*PC        Yes, write to VDP
       DINC @PC               Point to next byte
       B    LDP4              Continue with LOAD routine
* RXB PATCH FILL EMPTY SPACE *****************************
       B    LDP4
* GROM ADDRESS >C088 FOR LDP5
* Check for ")"  IF there return ELSE SYNTAX ERROR
LDP5   CEQ  RPARZ,@CHAT       Return
       BS   LDRET
       B    ERRSY1            SYNTAX ERROR
* LDP2
* Process file name
LDP2   CZ   @FAC7             Check for null string
       BS   LDNE2
* GKXB Change 'LOAD FILE' to check for INIT
       CALL GKINIT
*************** LOAD DATA INTO ERAM ***********************
* LOAD FRESTA, FREEND from ERAM
       DST  FSLOC,@VARB           Source
       DST  FRESTA,@VAR0          Destination
       DST  4,@ARG                # of bytes to move
       XML  MVUP                  Load
* Initialize PC, OFFSET in case of no "0" tag
       DST  @FRESTA,@PC
       DST  @FRESTA,@OFFADD   Base address for load module
* Read in one record, evaluate the TAG field
* LDRD - LDTG
LDRD   DST  0,@CHKSUM         Clear check sum
       CALL READIT            Rear in a record
LDTG   MOVE 5,V*BUFPNT,@TAG   Get TAG & field
       CALL LDIPCS            Add 5 to BUFPNT, add ASCII
       BYTE 5               * Value of chars. Read to check
* Convert @FIELD to numeric (from ASCII hex value)
* Store result: HIGH BYTE to FIELD, LOW BYTE to FIELD+1
* Convert HIGH BYTE first: @FIELD & @FIELD+1
* Store result in field
       SUB  >30,@FIELD        >30 = "0"
       CGT  9,@FIELD          Subtract ASCII difference
*                              between "9" and "A"
       BR   GC0C7
       SUB  7,@FIELD
GC0C7  SLL  4,@FIELD          FIELD=FILED*32
       SUB  >30,@FIELD+1
       CGT  9,@FIELD+1
       BR   GC0D5
       SUB  7,@FIELD+1
GC0D5  ADD  @FIELD+1,@FIELD   Add to HIGH BYTE
* Now convert LOW BYTE: @FIELD+2 & @FIELD+3
* Store result in LOW BYTE of FIELD to FIELD+1
       SUB  >30,@FIELD+2
       CGT  9,@FIELD+2
       BR   GC0E3
       SUB  7,@FIELD+2
GC0E3  ST   @FIELD+2,@FIELD+1 Store in LOW byte of result
       SLL  4,@FIELD+1        FIELD+1 = FIELD+1*32
       SUB  >30,@FIELD+3
       CGT  9,@FIELD+3
       BR   GC0F4
       SUB  7,@FIELD+3
GC0F4  ADD  @FIELD+3,@FIELD+1 Add to low byte
* Branch to evaluation procedure for TAG
       SUB  >30,@TAG          >30 = "0"
       CGE  0,@TAG            If TAG < "0" ILLEGAL CHAR
       BR   ERRUC1
       CGT  >0A,@TAG          TAGS "0" to ":"
       BS   GC11C
       CASE @TAG
       BR   TAG0              "0" RELOCATABLE LENGTH
       BR   LDTG              IGNORE "1" TAG
       BR   LDTG              IGNORE "2" TAG
       BR   ERRUC1            No external REF "3"
       BR   ERRUC1            No external REF "4"
       BR   TAG5              "5" relocatable entry DEF
       BR   TAG6              "6" Absolute entry    DEF
       BR   TAG7              "7" check sum
       BR   LDTG              "8" ignore check sum
       BR   TAG9              "9" Absolute LOAD address
       BR   LDDNE             ":" end of file
GC11C  SUB  >11,@TAG          Subtract offset so
*                              that "A" is =0
       CGE  0,@TAG            ";" to "@" illegal char
       BR   ERRUC1
* Skip over "I" tag - 8 char, program ID that follows
       CEQ  8,@TAG
       BS   LDTG2
* Skip over "M" TAG -10 char, program ID that follows
       CEQ  12,@TAG
       BR   LDTG3
       CALL LDIPCS
       BYTE 10
       B    LDTG
LDTG3  CGT  5,@TAG            TAGS "G" are legal
       BS   ERRUC1
       CASE @TAG
       BR   TAGA              "A" RELOCATABLE PROGRAM ADDRE
       BR   TAGB              "B" ABSOLUTE VALUE
       BR   TAGC              "C" RELATIVE ADDRESS
       BR   ERRUC1            "D" ERROR
       BR   ERRUC1            "E" ERROR - UNDEFINED
       BR   LDRD              "F" END OF RECORD
* TAG0 to TAGB
* EVALUATE TAG FIELDS
TAG0   DST  @FRESTA,@OFFADD   NEW BASE ADDRESS
       DST  @FRESTA,@PC       NEW PC
       DADD @FIELD,@FRESTA    ADD LENGTH TO FIND END OF
*                              RELOCATABLE PROGRAM WHICH IS
*                              START OF NEXT PROGRAM
* Make sure we won't run into routine name table now, so we
*  don't have to check every time we load a value into ERAM
*  routine table must make sure it doesn't run into
*  relocatable assembly language code through.
       DCHE @FREEND,@FRESTA   OUT OF MEMORY
       BS   ERRMF1
* SKIP OVER PROGRAM ID - 8 BYTES
LDTG2  CALL LDIPCS
       BYTE 8               * INC BUFPNT, COMPUTE CHECKSUM
       B    LDTG
TAG5   DADD @OFFADD,@FIELD    Add starting offset
* TAG6 is an absolute address so do not need to add offset
TAG6   MOVE 6,V*BUFPNT,@INDEX    Get symbol name
       CALL LDIPCS            INC BUPNT, COMPUT CHECKSUM
       BYTE 6              *  We read 6 chars
* Add symbol and its address - stopped in field - to the
*  routine entry table. It is put at the end of the table
*  (the end of the table is towards the low end of memory)
*  Since the table is searched from the end first, if there
*  are any duplicate labels the last one entered will have
*  precedence over the early one(s).
       DDECT @FREEND          Set to address field
* Load address (stored in field in CPU RAM) into routine
*  Name table which is in expansion RAM
       DST  FIELD,@VARB        Source
       DST  @FREEND,@VAR0      Destination
       DST  2,@ARG             # bytes to move
       XML  MVUP              CPUR RAM to ERAM
* Load symbol into routine name table
       DSUB 6,@FREEND         Set to symbol field
       DST  INDEX,@VARB         Source
       DST  @FREEND,@VAR0       Destination
       DST  6,@ARG              Move 6 bytes
       XML  MVUP              CPU RAM to ERAM
* Check to see if we've run into assembly language code
       DCHE @FREEND,@FRESTA   Out of memory
       BS   ERRMF1
       B    LDTG              If not then continue
***********************************************************
* ROUTINE NAME TABLE ENTRY
*
*                     0   1   2   3   4   5   6  7
*                   -----------------------------------
*        FREEND     | S | Y | M | B | O | L | ADDRESS |
*    (AFTER ENTRY)  -----------------------------------
*        FREEND     |   |   |   |   |   |   |         |
*    (BEFORE ENTRY) -----------------------------------
*
*  FREEND is initialized to >4000 by INIT, address is at
*   a higher memory location then symbol
***********************************************************
TAG7   DNEG @FIELD            Checksum is 1's compelement
       DCEQ @FIELD,@CHKSUM    Check sum error
       BR   ERRDE1
       B    LDTG
TAGA   DADD @OFFADD,@FIELD    PC = OFFADD ^ FIELD
* TAG 9 is an absolute address so no need to add offset
TAG9   DST  @FIELD,@PC
       B    LDTG
TAGC   DADD @OFFADD,@FIELD
* TAG B is an absolute entry so no need to add offset
* Relocatable code is checked to see if it will run into
*  is no need to check now. Absolute code can go anywhere.
*
* Load field into expansion RAM using MVUP routine
TAGB   DST  @PC,@VAR0           Destination
       DST  FIELD,@VARB         Source
       DST  2,@ARG              Move 2 bytes
       XML  MVUP              CPU RAM to ERAM
       DINCT @PC              We loaded 2 bytes
       B    LDTG
********* END OF LOAD FOR CURRENT FILE ********************
*
* FRESTA & FREEND are stored in CPU RAM (>8308)
* While loading a file into expansion RAM.
* So if the values of FRESTA or FREEND are to be changed
* then word locations >8308 and >830A must be changed and
* not expansion RAM.
*
* LDDNE - LDNE2
*
*   DONE WITH LOAD
* Put FRESTA, FREEND back into expansion RAM
* If FRESTA is odd then make it even
*  so that the next program starts on an even boundry
LDDNE  CLOG 1,@FRESTA+1       Low byte odd?
       BS   GC1C1
       DINC @FRESTA           Force to next even boundry
GC1C1  DST  FRESTA,@VARB          Source
       DST  FSLOC,@VAR0           Destination
       DST  4,@ARG                Load 4 bytes
       XML  MVUP              CPU RAM to ERAM
       CALL CLSIT             Close file
* Check for end of load command ")"
LDNE2  CEQ  RPARZ,@CHAT       Check for ")"
       BS   LDRET
       CEQ  COMMAZ,@CHAT      Syntax error
       BR   ERRSY1
       XML  PGMCHR            Skip comma
       B    LDP1              Continue in main loop
*************** LDRET - LDRET2 ****************************
*
* Return to calling routine
LDRET  XML  PGMCHR            Skip over
* Entry point for INIT
LDRET2 CALL CHKEND            Check for end of statement
       BR   ERRSY1            If not end then syntax error
       CALL RPL               Return to caller
********************** CHKIN ******************************
* Check for INIT-FLAG = >AA55
* MOVE ERAM(INITF) to CPU *FAC
PAGE   EQU  $
CHKIN  DST  FAC,@VAR0         Destination
       DST  INITF,@VARB       Source
       DST  2,@ARG            2 bytes
       XML  MVUP              Move it
       DCEQ >AA55,@FAC        Syntax error
       BR   ERRSYN
* No files have been opened so if there is a syntax error
*  goto ERRSYN!
       RTN
*********************** FILE ROUTINES *********************
***********************************************************
* INCREMENT BUFFER POINTER by value after call statement
* ADD VALUES READ TO CHECKSUM unless the first character
* is a "7" = >37 , then add only "7" character to checksum
* (other value is the checksum)
*
*************************** LDIPCS ************************
LDIPCS FETCH @INDEXC          Index = # of bytes read
       CEQ  >37,V*BUFPNT
       BR   GC213
       DADD >0037,@CHKSUM     Add value of "7" to checksum
       DADD 5,@BUFPNT         1 for "7", 4 for checksum
       B    GC224
GC213  ST   V*BUFPNT,@FAC1    Convert to 2 byte value
       CLR  @FAC              -----------------------------
       DADD @FAC,@CHKSUM      Add char to checksum
       DINC @BUFPNT
       DEC  @INDEXC           Do it index # of times
       CZ   @INDEXC
       BR   GC213
GC224  RTN
********************** OPENIT *****************************
OPENIT DST  @FAC6,@BYTES      Store actual spec length
       DADD PABLEN+80,@BYTES  Add in the PAB length and
*                              buffer length
       XML  VPUSH             Push possible temp string
       XML  GETSTR             and try to allocate space
       XML  VPOP              Restore original string data
*
* THE FOLLOWING VARIABLES CONTAIN IMPORTANT INFO
*
*   FAC4, FAC5    Start address of original device specific
*   FAC6, FAC7    Length of original device specifications
*   SREF          Location of PAB in VDP memory
*   BYTES         Length of entire PAB including specificat
       MOVE @FAC6,V*FAC4,V@PABLEN(@SREF)
       CLR  V*SREF               Clear the entire PAB
       MOVE PABLEN-1,V*SREF,V@1(@SREF)
       ST   @FAC7,V@NLEN(@SREF)  Copy specifications length
       ST   >60,V@SCR(@SREF)     Screen offset
       ST   4,V@FLG(@SREF)       Dis, fix, seq, input
       DADD @SREF,@FAC6          Calculate the address of
       DADD PABLEN,@FAC6          the buffer
       DST  @FAC6,V@BUF(@SREF) Store buffer address in PAB
       CALL DSRCAL
       RTN
***********************************************************
READIT DST  V@BUF(@SREF),@BUFPNT   INIT buffer pointer
       ST   2,V*SREF
       ST   V@LEN(@SREF),V@CHRCNT(@SREF)
       CALL DSRCAL
       RTN
************************* CLSIT ***************************
CLSIT  ST   1,V*SREF          Prepare to close
******************** DSRCAL - DSKERR **********************
DSRCAL DST  @SREF,@FAC12      Compute start address of spec
       DADD NLEN,@FAC12       Ready to call DSR routine
       CALL DSR               Call DSR thourgh program link
       BYTE 8               * Type = DSR (8)
       BS   DSKERR            Couldn't find the DSR
       CLOG >E0,V@FLG(@SREF)  Set condition bit if no error
       BR   DSKERR
       RTN
DSKERR DST  @FREPTR,@PABPTR   Set up dummy PAB
       DSUB 6,@PABPTR         Make it standard size
       DST  V*SREF,V@4(@PABPTR) Store error code
       CALL CLSNOE              Close File
       CALL ERRZZ               Issue I/O error
       BYTE 36              *
********************** CLSNOE *****************************
* Try to close the current file
* Ignore any errors from the closing of the file.
* Since the PAB is not in the normal PAB list
*  then we have to close the file in the load routine.
* ERRZZ will close the rest of the files.
*
** CLOSE IT ONLY IF IT HAS BEEN OPENED
CLSNOE DCEQ 1,@CHKSUM         Check file flag
       BS   GC2B9
       ST   1,V*SREF          Store close file code
       DST  @SREF,@FAC12      Compute start address of spec
       DADD NLEN,@FAC12       Ready to CALL DSR
       CALL DSR               CALL DSR through program link
       BYTE 8               * "8" is type of DSR
GC2B9  RTN
***********************************************************
* INIT                        JDH   9/02/80
***********************************************************
* Check if expansion RAM present
* Load support into expansion RAM from GROM
INIT   CZ   @RAMTOP           If no ERAM, SYNTAX ERROR
       BS   ERRSYN
** Load Assembly header, support routines **
* GKXB Correct INIT routine.
       MOVE >04EA,G@ALCEND,@>2000
       B    LDRET2
***********************************************************
***********************************************************
* PEEK INSTRUCTION            JDH   9/04/80
***********************************************************
*
* FORMAT:
*  CALL PEEK open address (comma numeric-variable) * close
* FUNCTION:
*  RETURNS THE VALUE AT address IN ERAM INTO numeric-variab
*  IF MORE THAN ONE numeric-variable IS SPECIFIED THEN
*  address IS INCREMENTED AND THE VALUE IN ERAM AT THE NEW
*  address IS ASSIGNED TO THE NEXT VARIABLE AND SO ON.
*
PEEK   CEQ  LPARZ,@CHAT       Chat = "("
       BR   ERRSYN
       XML  PGMCHR            Skip "("
       XML  PARSE             Get value of address
       BYTE RPARZ
       CEQ  STRING,@FAC2      Address MUST BE NUMERIC
       BS   ERRSNM
       XML  CFI               Convert FAC to integer
       CEQ  3,@FAC10          Overflow?
       BS   ERRNO
       DST  @FAC,@PC          Save peek address
       CEQ  COMMAZ,@CHAT      CHAT = "," ?
       BR   ERRSYN
PEEK2  XML  PGMCHR            Skip ","
* The following check has been put in SYM, 5/26/81
* If @CHAT >= >80 then ERRSYN (Don't allow token)
       XML  SYM               Get symbol name
       XML  SMB               Get value pointer
       XML  VPUSH             Save FAC on stack for ASSGNV
       CZ   @FAC2             Must be numeric
       BR   ERRSNM
       CLR  @FAC
       MOVE 7,@FAC,@FAC1      Clear FAC
** GET PEEK VALUE FROM ERAM INTO  @FAC1
* GKXB Change PEEK routine to read VDP/GRAM. Move CPU read
*      code to PEEKDT and add code for bite check and VDP
*      read.
       CLOG >08,@GKFLAG       Check VDP bit
       BS   PKGRAM            No, check GROM bit
       ST   V*PC,@FAC1        Yes, read VDP
       B    GC308
GC308  XML  CIF               Convert FAC to F.P. value
       XML  ASSGNV            Assign to numeric-variable
       CEQ  COMMAZ,@CHAT
       BR   PEEK5
       DINC @PC               INC pointer to next ERAM addr
       B    PEEK2
* CHECK FOR ")" AND END OF STATEMENT
* IF ALL OK, THEN RETURN TO CALLER
* GETCHR ALSO RETURNS TO HERE
PEEK5  CEQ  RPARZ,@CHAT
       BR   ERRSYN
       XML  PGMCHR            Skip "("
       CALL CHKEND
       BR   ERRSYN
       CALL RPL               RETURN TO CALLER
***********************************************************
* LINK INSTRUCTION : SE Sep 1980
***********************************************************
*  FORMAT:
*  CALL LINK("file-name",parameter1,parameter2,...)
*
*  LINK ROUTINE READS THE FILE NAME SPECIFIED BY THE USER A
*  SAVE THE ADDRESS OF THE NAME FOR LATER USE. THE FILE WIL
*  BE SEARCHED IN UTILITY CODE LATER ON.
*
*  PARAMETERS ARE PASSED EITHER BY REFERENCE OR BY VALUE.
*  NUMERIC OR STRING VARIABLES AND NUMERIC OR STRING ARRAYS
*  ARE PASSED BY REFERENCE AND ALL OTHERS INCLUDING A USER
*  DEFINED FUNCTION ARE PASSED BY VALUE.
*
*  PARAMETER INFORMATION IS STORED IN CPU >8300 THROUGH >83
*  THAT GIVES A PARAMETER TYPE CODE OF EACH PARAMETER.
*        CODE 0 ... Numeric expression
*        CODE 1 ... String experession
*        CODE 2 ... Numeric variable
*        CODE 3 ... String variable
*        CODE 4 ... Numeric array
*        CODE 5 ... String array
*
*  IF A PARAMETER IS PASSED AS A NUMERIC EXPRESSION ITSL
*  ACTUAL VALUE GETS PUSHED INTO THE VALUE STACK. IN CASE O
*  A STRING EXPRESSION , ITS VALUE STACK CONTAINS AN ID(>65
*  POINTER TO THE VALUE SPACE AND ITS LENGTH. IF A PARAMETE
*  GETS PASSED AS A REFERENCE THE PRODUCT OF XML SYM AND XM
*  SMB IN THE @FAC AREA GETS PUSHED INTO STACK.
*
*  AFTER AN ASSEMBLY LANGUAGE SUBPROGRAM IS EXECUTED LINK
*  ROUTINE WILL POP THE STACK TO GET RID OF PARAMETER
*  INFORMATION. CONTROL WILL BE TRANSFERED TO THE XB MAIN
*  PROGRAM AFTERWARDS.
*
***********************************************************
* CALL LINK program
***********************************************************
LINKIT CALL CHKIN             Check if INIT has been called
       DST  @VSPTR,@OLDS      Save VSPTR for later use
       CEQ  LPARZ,@CHAT       Check for "("
       BR   ERRSYN
       XML  PGMCHR            Advance program pointer
       XML  PARSE             Get the routine name.
       BYTE RPARZ           * Read up to ")"
       CEQ  >65,@FAC2         Should be a string
       BR   ERRBA
       DCZ  @FAC6             Don't accept null string
       BS   ERRBA
       CH   6,@FAC7           Should be less then 6 char
       BS   ERRBA
       XML  VPUSH             Push to make it semi-permanen
       CLR  @COUNT            Initialize parameter counter
***********************************************************
* PARAMETERS get evaluated here
***********************************************************
PAR01  CEQ  RPARZ,@CHAT       No arg. So execute it
       BS   EXE01
       CEQ  COMMAZ,@CHAT      Should have a comma
       BR   ERRSYN
       DST  @PGMPTR,@ERRCOD   Save text pointer
       XML  PGMCHR            Get the character
       CHE  >80,@CHAT         Must be an expression
       BS   VAL01
* If CHAT = LPARZ then pass by expression
       CALL CLRFAC            Clear FAC entry for SYM
       XML  SYM               Read in the symbol table info
* After XML SYM @FAC area contains a pointer to symbo table
* Below statement checks if it is a UDF.
       CLOG >40,V*FAC         Pass by value
       BR   VAL01
       CEQ  COMMAZ,@CHAT      Pass by reference
       BS   REF01
       CEQ  RPARZ,@CHAT       Pass by reference
       BS   REF01
       CEQ  LPARZ,@CHAT       An array
       BS   ARRAY
       CHE  >80,@CHAT         Pass by value
       BS   VAL01
       BR   ERRSYN
***********************************************************
* ARRAY case gets checked here
***********************************************************
* Should look like A(,,) etc.
* Stack entry for an array will look like
* +--------------+-------+---+-------------+---------------
* | Pointer to   |  >00  |   | Pointer to  |
* | symbol table |   or  |   | dim info in |
* | entry        |  >65  |   | real v.s.   |
* +- FAC --------+ FAC2 -+---+- FAC4 ------+- FAC6 --------
*
ARRAY  XML  PGMCHR            Get the next character
       CEQ  RPARZ,@CHAT       Pass by reference
       BS   ARRAY2
       CEQ  COMMAZ,@CHAT      More array information
       BS   ARRAY
       DDEC @PGMPTR           Adjust the pointer
       ST   LPARZ,@CHAT
       BR   REF01             Pass by reference
* In array cases the symbol table address gets stored at FA
* area, and the pointer to the value space (dimension info)
* goes into FAC4
ARRAY2 XML  PGMCHR            Advance the program pointer
       CLOG >80,V*FAC         Test string bit
       BR   GC39D
       ST   4,*COUNT          Numeric array
       BR   GC3A1
GC39D  ST   5,*COUNT          String array case
* Check if array is being shared. If it is then go back
* through the linkage to get the actuals symbol table
* pointer. Put the pointer to the value space (dimension in
* into FAC4.
GC3A1  CLOG >20,V*FAC         Shared array?
       BS   GC3BE
       MOVE 2,V@6(@FAC),@FAC4 If so, get pointer
       CLOG >20,V@-6(@FAC4)   Shared also?
       BS   GC3BC
       MOVE 2,V*FAC4,@FAC4    Array is not shared
GC3BC  BR   GC3C5
GC3BE  DST  @FAC,@FAC4        Array is not shared
       DADD 6,@FAC4           Point to value space
GC3C5  BR   PUSH
***********************************************************
* VALUE
*  Passing the parameter by value
***********************************************************
VAL01  DST  @ERRCOD,@PGMPTR   Restore program pointer
       XML  PGMCHR            Skip the first character
       DST  @BYTES,@TEMP      In case of passing a string
       XML  PARSE             Parsing up to comma
       BYTE RPARZ
       DST  @TEMP,@BYTES      Restore the value in >0C area
* After parsing @FAC area contains its actual numeric value
*  in a numeric case, and the following information in a
*  string case.
* +----------------+-----+--+------------+-----------------
* | >001C  or      | >65 |  | Pointer to | Length of string
* | value pointer  |     |  | string     | string
* | address        |     |  |            |
* +- FAC ----------+-FAC2+--+-FAC4 ------+- FAC6 ----------
*
       CGT  >63,@FAC2         If more then 99 then
       BR   GC3E0
       ST   1,*COUNT          Store flag for string express
       BR   GC3E3
GC3E0  CLR  *COUNT            Otherwise it is a numeric exp
GC3E3  BR   PUSH              Push into stack
***********************************************************
* REFERENCE
*   Passing the parameter by reference
***********************************************************
* Variables, array element and whole array passing.
*
* After SMB @FAC entry shold look like;
* +--------------+------+-----+-------------+--------------
* | Pointer to   | >00  |     | Pointer to  |
* | symbol table |      |     | value space |
* | entry        |      |     |             |
* +-- FAC -------+ FAC2 +-----+- FAC4 ------+- FAC6 -------
*  for numeric case, and
* +--------------+------+-----+-------------+--------------
* | Pointer to   | >65  |     | Pointer to  | String
* | value space  |      |     | string      | length
* | entry        |      |     |             |
* +- FAC --------+ FAC2 +-----+- FAC4 ------+- FAC6 -------
* for a string case.
REF01  XML  SMB               Get the location
       CHE  >B8,@CHAT         Pass array expression
       BS   VAL01
       CZ   @FAC2
       BR   GC3F6
       ST   2,*COUNT          Must be a numeric variable
       BR   PUSH
GC3F6  ST   3,*COUNT          Must be a string variable
***********************************************************
* PUSH routine
*  Pushes @FAC entry into a value stack.
***********************************************************
PUSH   INC  @COUNT
       CGT  16,@COUNT         Too many parameters
       BS   ERRBA
       XML  VPUSH
       BR   PAR01             Get the next argument.
***********************************************************
* EXECUTE routine
*  Restore file name info transfer control over to ALC
***********************************************************
EXE01  ST   >20,@FAC          Store blank in the FAC area.
       MOVE 5,@FAC,@FAC1
       MOVE 4,V@12(@OLDS),@STORE   Get the file name info
       MOVE @STORE+2,V*STORE,@FAC  Move to FAC
       DCLR @ERRCOD           Clear program pointer for
*                              error code
       XML  ALSUP             Go to CPU at >2000 to execute
       BS   ERROR             Error found
*                             If no error, start checking s
***********************************************************
* RETURN to the XB main program.
***********************************************************
NOERR  DCH  @OLDS,@VSPTR      Pop the stack
       BR   GC429
       XML  VPOP              Pop the stack
       B    NOERR
GC429  B    LNKRTN            Check ")" and end of statemen
***********************************************************
* SUBROUTINES used in this file.
***********************************************************
CLRFAC CLR  @FAC
       MOVE 7,@FAC,@FAC1
       RTN
***********************************************************
* CHARPAT ROUTINE             99/4A - JDH 10/01/80
***********************************************************
*
* FORMAT:
*  CALL CHARPAT open (numeric expression, string expression
*
*  FUNCTION:
*   RETURNS THE CHARACTER DEFINITION PATTERN FOR CHARACTER
*   NUMBER <numeric expression> INTO <string expression>
*
******************* GETCHR - GETCHR2***********************
GETCHR CEQ  LPARZ,@CHAT
       BR   ERRSYN
GCHR2  XML  PGMCHR
       XML  PARSE
       BYTE RPARZ
       CEQ  STRING,@FAC2      Can't be a string
       BS   ERRSNM
       XML  CFI               Convert FAC to integer
       CEQ  3,@FAC10          Range 32 to 143
       BS   ERRBA
       DCGE 30,@FAC           30
       BR   ERRBA
       DCGT 159,@FAC          159
       BS   ERRBA
       DSLL 3,@FAC            8 bytes / entry so times 8
       DST  >0300,@TBLPTR     Base of char table less 32*8
       DADD @FAC,@TBLPTR      Add in arg offset
       DST  16,@BYTES         16 byte string in string spac
       XML  GETSTR
       DST  @SREF,@STRPTR     Save pointer to string
       ST   8,@INDEXC         Loop counter
GC46D  ST   V*TBLPTR,V*STRPTR
       SRL  4,V*STRPTR        Get rid of low nibble
       ADD  >30,V*STRPTR      Add ASCII "0"
       CGT  >39,V*STRPTR      >39 = ASCII "9"
       BR   GCHR3
       ADD  7,V*STRPTR        Value "A" to "F"
GCHR3  DINC @STRPTR
       ST   V*TBLPTR,V*STRPTR
       AND  >0F,V*STRPTR
       ADD  >30,V*STRPTR      Add ASCII "0"
       CGT  >39,V*STRPTR
       BR   GCHR4
       ADD  7,V*STRPTR        Value "A" to "F"
GCHR4  DINC @TBLPTR
       DINC @STRPTR
       DEC  @INDEXC
       CZ   @INDEXC
       BR   GC46D
* NOW assign the string just created to the string
*  variable following
       XML  PGMCHR            Skip comma
* The following check has been put in SYM, 5/26/81
* If CHAT >= >80 then ERRSYN (Do not allow token).
       XML  SYM           Get symbol table info for next ar
       XML  SMB
       XML  VPUSH         Save on stack for ASSGNV
       CEQ  STRING,@FAC2      Must be a stirng variable
       BR   ERRSNM
       DST  >001C,@FAC        Temp string so use SREF as ad
       DST  @SREF,@FAC4       Pointer to string
       DST  16,@FAC6          String length
       XML  ASSGNV            Assign to string variable
       CEQ  COMMAZ,@CHAT
       BS   GCHR2
       B    PEEK5
***********************************************************
************** ERROR BRANCH TABLE FOR LINK ****************
***********************************************************
ERROR  CASE  @ERRCOD
       BR   NOERR
       BR   NOERR
       BR   ERRNO             2 Numeric Overflow
       BR   ERRSYN            3 SYNtax error
       BR   ERRIBS            4 Illegal after subprogram
       BR   ERRNQS            5 unmatched quotes
       BR   ERRNTL            6 Name Too Long
       BR   ERRSNM            7 String Number Mismatch
       BR   ERROBE            8 Option Base Error
       BR   ERRMUV            9 iMproperly Used name
       BR   ERRIM            10 IMage error
       BR   ERRMEM           11 MEMory full
       BR   ERRSO            12 Stack Overflow
       BR   ERRNWF           13 Next Without For
       BR   ERRFNN           14 For Next Nesting
       BR   ERRSNS           15 must be in subprogram
       BR   ERRRSC           16 Recursive Subprogram Call
       BR   ERRMS            17 Missing Subend
       BR   ERRRWG           18 Return Without Gosub
       BR   ERRST            19 String Truncated
       BR   ERRBS            20 Bad Subscript
       BR   ERRSSL           21 Speech String too Long
       BR   ERRLNF           22 Line Not Found
       BR   ERRBLN           23 Bad Line Number
       BR   ERRLTL           24 Line Too Long
       BR   ERRCC            25 Can't Continue
       BR   ERRCIP           26 Command Illegal in Program
       BR   ERROLP           27 Only Legal in a Program
       BR   ERRBA            28 Bad Argument
       BR   ERRNPP           29 No Program Present
       BR   ERRBV            30 Bad Value
       BR   ERRIAL           31 Incorrect Argument List
       BR   ERRINP           32 INPut error
       BR   ERRDAT           33 DATa error
       BR   ERRFE            34 File Error
       BR   NOERR
       BR   ERRIO            36 I/O error
       BR   ERRSNF           37 Subprogram Not Found
       BR   NOERR
       BR   ERRPV            39 Protected Violation
       BR   ERRIVN           40 unrecognized Character
       BR   WRNNO            41 Numeric Number Overflow
       BR   WRNST            42 String Truncated
       BR   WRNNPP           43 No Program Present
       BR   WRNINP           44 INPut error
       BR   WRNIO            45 I/O error
       BR   WRNLNF           46 Line Not Found
***********************************************************
**************** ERROR HANDLING SECTION *******************
***********************************************************
ERRN01 CALL CLSNOE            * ENTRY FOR LOAD
ERRNO  CALL ERRZZ             * Numeric Overflow
       BYTE 2
ERRSY1 CALL CLSNOE            * ENTRY FOR LOAD
ERRSYN CALL ERRZZ             * SYNtax error
       BYTE 3
ERRIBS CALL ERRZZ             * Illegal after subprogram
       BYTE 4
ERRNQS CALL ERRZZ             * uNmatched QuoteS
       BYTE 5
ERRNTL CALL ERRZZ             * Name Too Long
       BYTE 6
ERRSNM CALL ERRZZ             * String Number Mismatch
       BYTE 7
ERROBE CALL ERRZZ             * Option Base Error
       BYTE 8
ERRMUV CALL ERRZZ             * Improperly used name
       BYTE 9
ERRIM  CALL ERRZZ             * Image Error
       BYTE 10
ERRMF1 CALL CLSNOE            * ENTRY FOR LOAD
ERRMEM CALL ERRZZ             * MEMory full
       BYTE 11
ERRSO  CALL ERRZZ             * Stack Overflow
       BYTE 12
ERRNWF CALL ERRZZ             * Next Without For
       BYTE 13
ERRFNN CALL ERRZZ             * For-Next Nesting
       BYTE 14
ERRSNS CALL ERRZZ             * must be in subprogram
       BYTE 15
ERRRSC CALL ERRZZ             * Recursive Subprogram Call
       BYTE 16
ERRMS  CALL ERRZZ             * Missing Subend
       BYTE 17
ERRRWG CALL ERRZZ             * Return Without Gosub
       BYTE 18
ERRST  CALL ERRZZ             * String Truncated
       BYTE 19
ERRBS  CALL ERRZZ             * Bad Subscript
       BYTE 20
ERRSSL CALL ERRZZ             * Speech String too Long
       BYTE 21
ERRLNF CALL ERRZZ             * Line Not Found
       BYTE 22
ERRBLN CALL ERRZZ             * Bad Line Number
       BYTE 23
ERRLTL CALL ERRZZ             * Line Too Long
       BYTE 24
ERRCC  CALL ERRZZ             * Can't Continue
       BYTE 25
ERRCIP CALL ERRZZ             * Command Illegal in Program
       BYTE 26
ERROLP CALL ERRZZ             * Only Legal in a Program
       BYTE 27
ERRBA  CALL ERRZZ             * Bad Argument
       BYTE 28
ERRNPP CALL ERRZZ             * No Program Present
       BYTE 29
ERRBV  CALL ERRZZ             * Bad Value
       BYTE 30
ERRIAL CALL ERRZZ             * Incorrect Argument List
       BYTE 31
ERRINP CALL ERRZZ             * INPut error
       BYTE 41
ERRDE1 CALL CLSNOE            * ENTRY FOR LOAD
ERRDAT CALL ERRZZ             * DATa error / Checksum error
       BYTE 33
ERRFE  CALL ERRZZ             * File Error
       BYTE 34
ERRIO  CALL ERRZZ             * I/O error
       BYTE 36
ERRSNF CALL ERRZZ             * Subprogram Not Found
       BYTE 37
ERRPV  CALL ERRZZ             * Protection Violation
       BYTE 39
ERRUC1 CALL CLSNOE            * ENTRY FOR LOAD
ERRIVN CALL ERRZZ             * Unrecognized character / il
       BYTE 40
WRNNO  CALL WARNZZ            * Numeric Overflow
       BYTE 2
       BR   NOERR
WRNST  CALL WARNZZ            * String Truncated
       BYTE 19
       BR   NOERR
WRNNPP CALL WARNZZ            * No Program Present
       BYTE 29
       BR   NOERR
WRNINP CALL WARNZZ            * INPut Error
       BYTE 32
       BR   NOERR
WRNIO  CALL WARNZZ            * I/O error
       BYTE 35
       BR   NOERR
WRNLNF CALL WARNZZ            * Line Not Found
       BYTE 38
       BR   NOERR
***********************************************************
* RXB move INIT code to >9800
***********************************************************
*
* CALL QUITON routine
*
QTON   DATA QTOFF
       STRI 'QUITON'
       DATA QTON1
QTON1  AND  >EF,@GKFLAG  Reset QUIT bit
       B    LDRET2       Return
*
* CALL QUITOFF routine
*
QTOFF  DATA POKEV
       STRI 'QUITOFF'
       DATA QTOFF1
QTOFF1 OR   >10,@GKFLAG  Set QUIT bit
       BR   LDRET2       Return
*
* Set-up for CALL GKLOAD routine
*
GKLOAD AND  >F0,@GKFLAG  Reset flag bits
       RTN               Return
*
* POKEV routine
*
POKEV  DATA PEEKV
       STRI 'POKEV'
       DATA POV
POV    CALL GKSETV       Set VDP bit
       DST  1,@CHKSUM    For GKLOAD routine
       B    GC047        Goto GKLOAD
*
* Check for CALL GKINIT on 'LOAD FILE'
*
GKINIT XML  VPUSH        Save FAC
       CALL CHKIN        Check for GKINIT
       XML  VPOP         Restore FAC
       CLOG >C,@GKFLAG   Error if POKEG or POKEV
       BR   ERRSYN
       B    OPENIT       Open the file
*
* New entry point for CALL PEEK,
* clears flag bits.
*
GKPEEK AND  >F0,@GKFLAG
       B    PEEK
*
* PEEKV routine
*
PEEKV  DATA PEEKG
       STRI 'PEEKV'
       DATA PKV
PKV    CALL GKSETV       Set VDP bit
       B    PEEK         Use PEEK routine
*
* Set flag bit for VDP read & write
*
GKSETV AND  >F0,@GKFLAG  Reset both bits
       OR   8,@GKFLAG    Set VDP bit
       RTN               Return
*
* Set flag bit for GROM read & write
*
GKSETG AND  >F0,@GKFLAG  Reset both bits
       OR   4,@GKFLAG    Set GROM bit
       RTN               Return
*
* PEEKG routine
*
PEEKG  DATA POKEG
       STRI 'PEEKG'
       DATA PKG
PKG    CALL GKSETG       Set flag bit
       B    PEEK         Use PEEK routine
*
* POKEG routine
*
POKEG  DATA CATLOG
       STRI 'POKEG'
       DATA POG
POG    CALL GKSETG       Set flag bit
       DST  1,@CHKSUM    For LOAD routine
       B    GC047        Use LOAD routine
*
* Routine to write to GRAM
*
LDGRAM CLOG 4,@GKFLAG    Check GROM bit
       BS   LOADDT       No, CPU load
       MOVE 1,@FAC1,G@0(@PC) Write to GRAM
       DINC @PC          Point to next byte
       B    LDP4         Continue
*
* Relocated data from GKLOAD routine.
*
LOADDT MOVE 1,@FAC1,@0(@PC)   Read byte
       DINC @PC                INC ERAM address
       B    LDP4              Continue with next byte
*
* Routine to read GRAM/GROM
*
PKGRAM CLOG 4,@GKFLAG    Check flag
       BS   PEEKDT       No, CPU peek
       MOVE 1,G@0(@PC),@FAC1 Yes, read GRAM
       B    GC308        Continue
*
* Relocated data for CPU PEEK
*
PEEKDT MOVE 1,@0(@PC),@FAC1        Read byte
       B    GC308              Continue
***********************************************************
*
* Disk catalog routine
*
CATLOG DATA POKER
       STRI 'CAT'             CALL CAT(path)
       DATA GKCAT
*
*
*  X-BASIC DEVICE CATALOGER
*  Accessed with a CALL
*  PAB is installed in crunch buffer area
*
*  D.C. Warren 12/17/85
*  with modifications by Danny Michael, Jan. 86
*
*
GKCAT  CALL GLPARZ            Do we have a '(' ?
GKCATA CALL DSKNAM            Get path
*
* Set up PAB at V>8C0
*  Put disk information on the screen
*
       ALL  >80                 Clear screen
       DST  @FAC6,@VARB         Get name length
       DST  151,@BYTES          Length of CAT PAB use
       XML  GETSTR              Get some string space
       MOVE 150,V@RECBUF,V*SREF Save USER PAB area
       MOVE 9,G@GKPABD,V@RECBUF Install PAB
       ST   @FAC7,V@>08C9       Save Length 
       MOVE @VARB,V*FAC4,V@>08CA Get PATH
*
* Open Device
*
       CALL GKDSRL            Link to device
*
* Read first record
*
       DST  >020D,V@RECBUF    Make PAB a read
GKCAT2 CALL GKDSRL            Link to device
*
       ST   >B9,@AAA1         Y with offset
       CALL GKSCRN            Set up header
       CLR  @VARV             For GKSCRL routine
GKCATL CALL GKTKEY            Check for pause or quit
       BS   GKDONE            Stop!
       CALL GKSCRL            Scroll the screen
       CALL GKDSRL            Read a record
       CALL GKFNAM            Print it on screen
       BS   GKDONE            If finished
       BR   GKCATL            Loop
GKDONE CALL GKCLSF            Close file
       CEQ  COMMAZ,@CHAT      Comma?
       BS   GKCATA            Yes, another drive.
       CEQ  RPARZ,@CHAT       Last char a ) ?
       BR   ERRSYN            No, error
       XML  PGMCHR            Parse past ')'
       CALL CHKEND            SYNTAX error if not end
       BR   ERRSYN               .
       CALL RPL               Return to X-BASIC
*
* File error
*
GKERR  DST  RECBUF-4,@PABPTR  Fake a BASIC PAB
       DST  V@RECBUF,@VAR5    Save error
       CALL GKCLSF            Close file
       CALL G6D78             Return through ERR
       BYTE 36 *              I/O ERROR XX
*
*
* Subroutines
*
*
* Close file
*
GKCLSF DST  >010D,V@RECBUF    A close operation
       CALL GKDSR              Link to device
       MOVE 151,V*SREF,V@RECBUF Restore USER PAB area
       RTN                     Return to caller
*
* DSR LINK with error handling
*
GKDSRL CALL GKDSR
       BS   GKERR             Branch on no-device
       CEQ  >0D,V@>08C1       Check for device errors
       BR   GKERR                .
       RTN                    Return to caller
*
* DSR LINK routine
*
GKDSR  DST  >08C9,@FAC12      Name length pointer
       CALL >10               Call DSR
       BYTE 8 *               DSR call
       RTNC                   Return with COND bit
GKPABD BYTE 0,>D,9,0,0,0,0,0,0
*
* Screen - prints initial screen and disk info
*
GKSCRN FMT
        SCRO >60
        ROW  1
        COL  2
        HTEX 'DIRECTORY='
        ROW 2
        COL 2
        HTEX 'Free=          Used='
        ROW  22
        COL 3
        HTEX 'Filename  Size    Type     P'
        ROW+ 1
        COL 2
        HTEX '---------- ---- ----------- -'
       FEND
       CALL GKDSTR       Get path $ into FAC
       CZ   @FAC+1       Skip if zero length
       BS   GKCAT3
       FMT
        SCRO >60
        ROW 1
        COL 13
        HSTR 10,@FAC+2
       FEND
GKCAT3 DADD @FAC,@VAR5   Go to next field
       DADD 19,@VAR5     Continue to last field
       DST  73,@VAR9     Set up screen addr
       CALL GKDNUM       Display available space
* Display used space
       DSUB 9,@VAR5      Point to formatted space
       MOVE 8,V*VAR5,@ARG Move it to ARG
       XML  FSUB         Develop used value
       DST  88,@VAR9     Set up screen addr
       CALL GKDNU1       Display used space
       RTN               Return
*
* Test for space and FCTN 4
*
GKTKEY SCAN              Scan the keyboard
       BR   GKTKE1       Continue if no new key
       CEQ  SPACE,@RKEY  SPACE key?
       BR   GKTKE2       NO! Abort.
GKTKE3 SCAN              Scan keyboard
       BR   GKTKE3       Loop until new key press
       CEQ  SPACE,@RKEY  SPACE key?
       BR   GKTKE2       NO! Abort.
GKTKE1 RTN               Return
GKTKE2 CLR  @VAR0        Clear a byte
       CZ   @VAR0        Set COND bit
       RTNC              Return w/COND
*
* Scroll the screen
*
GKSCRL CH   18,@VARV           Check line counter
       BS   GKSCL1             Short scroll
       INC  @VARV              Line count +1
       MOVE >280,V@>80,V@>60   Scroll screen
GKSCL2 ST   SPACE,V@>2E0       Clear last line
       ADD  >60,V@>2E0
       MOVE >1F,V@>2E0,V@>2E1
       RTN                     Return
GKSCL1 MOVE >240,V@>C0,V@>A0
       BR   GKSCL2
*
* Display one file on screen
*
GKFNAM CALL GKDSTR       Get string into FAC
       CZ   @FAC+1       Skip display if zero
       BS   GKCAT5        length
       FMT
        SCRO >60         Put disk name on screen
        ROW   23            .
        COL   02            .
        HSTR 10,@FAC+2      .
       FEND                 .
GKCAT5 DADD @FAC,@VAR5   Go to next field
       DADD 10,@VAR5     Continue another field
       DCZ  V*VAR5       Time to get out if
       BS   GKFNA1        zero file size
       DST  >2EA,@VAR9   Set up screen address
       CALL GKDNUM       Display file length
       DSUB 9,@VAR5      Back a field
       MOVE 8,V*VAR5,@FAC Move it into FAC
       XML  CFI          Convert it to an int.
       CZ   @FAC         Non-negative?
       BS   GKCAT7       YES! File not protected
       ST   185,V@>02FE   Put a 'Y' on screen
       DNEG @FAC         Make number positive
GKCAT7 DEC  @FAC+1       Adjust for CASE
       CASE @FAC+1       Show file type
       BR   GKDF
       BR   GKDV
       BR   GKIF
       BR   GKIV
       BR   GKPR
       BR   GKDIR
GKDF   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Dis/Fix'
       FEND
       BR   GKCAT6
GKDV   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Dis/Var'
       FEND
       BR   GKCAT6
GKIF   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Int/Fix'
       FEND
       BR   GKCAT6
GKIV   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Int/Var'
       FEND
       BR   GKCAT6
GKPR   FMT
        SCRO >60
        ROW   23
        COL   18
        HTEX 'Program'
       FEND
       RTN
GKDIR  FMT
       SCRO  >60
       ROW   23
       COL   18
       HTEX  'Directory'
       FEND
       RTN               Return
GKCAT6 DADD 18,@VAR5     Advavce two fields
       DST  >2F6,@VAR9   Set up screen address
       CALL GKDNUM       Display record length
       RTN               Return
GKFNA1 CLR  @VAR0        Clear a byte
       CZ   @VAR0        Set COND bit
       RTNC              Return w/COND
* Display number subroutine
*  ENTER: Floating number in FAC for GKDNU1
*         Screen address in VAR9
*
GKDNUM MOVE 8,V*VAR5,@FAC Move FLP number to FAC
 
GKDNU1 CLR  @FAC+11      Indicate a free format
       XML  XCNS         Convert FAC to a string
       DST  7,@VARB      Right justify number
       SUB  @FAC+12,@VARB+1
       DADD @VARB,@VAR9
GKDNU2 ADD  >60,*FAC+11     Add offset to string
       ST   *FAC+11,V*VAR9  Put a char on the screen
       DINC @VAR9           Increment screen addr.
       INC  @FAC+11         Increment FAC addr.
       DEC  @FAC+12         Decrement string length count
       BR   GKDNU2          Loop until done
       RTN                  Return to caller
*
* Prepare a VDP string for FORMAT statement
*  LEAVE: FAC has string length (word)
*         FAC+2 has string
*         VAR5 pointing to next string in record
*
GKDSTR DST  >0900,@VAR5   Get buffer address
       CLR  @FAC          Clear MSB of FAC word
       ST   V*VAR5,@FAC+1 Store disk name length
       DINC @VAR5         Point to string
       ST   >20,@FAC+2    Clear out string space
       MOVE 9,@FAC+2,@FAC+3  .
       MOVE @FAC,V*VAR5,@FAC+2 Move disk name into FAC
       RTN
***********************************************************
DEVNAM CALL STRFCH            Get path string
       CEQ  >65,@FAC2         Do we have a string?
       BS   DEV1              YES, normal execution
       XML  CFI               Convert FAC to integer
       CEQ  >03,@FAC10        OK?
       BS   ERRBV             No.
       CHE  30,@FAC1          ASCII?
       BS   DEVASC            Yes.
       CHE  10,@FAC1          Higher then 9?
       BS   ERRBV             No, error
       ADD  48,@FAC1          Make it ASCII.
DEVASC ST   @FAC1,@TEMP1      Save the number
DEV0   DST  5,@BYTES          Set up for a string
       XML  GETSTR            Get string space
       MOVE 5,G@DSKSUB,V*SREF Save the string
       ST   @TEMP1,V@3(@SREF) Store the number
       DST  @BYTES,@FAC6      Copy string length.
       DST  @SREF,@FAC4       Copy string address.
DEV1   DCZ  @FAC6             Is it a null string?
       BS   ERRBA             YES! Bad Argument
       ST   V*FAC4,@TEMP1     Save device number
       CEQ  1,@FAC7           Length 1?
       BS   DEV0              Yes
       RTN
DSKSUB TEXT 'DSK#.'
*******************************
DSKDSR FETCH @FAC16           * Get Length of name
       FETCH @FAC17           * Get Subroutine #
       DST   @FAC16,V@>03C0   * Load into PAB
       DST   >03C0,@FAC12     * PAB address in VDP
       CALL  LINK             * DSRLNK
       BYTE  >0A              * Subroutine
       BS    ERRFE            * File Error
       SRL   5,@FAC6          *
       CZ    @FAC6            *
       BR    ERRFE            * File Error
       RTN                    *
*******************************
DSKNAM CALL DEVNAM            * DSK# SCS# WDS# HDK# IDE#
       MOVE 5,V*FAC4,@ARG     * Get device name
       ST   @ARG3,@DEVNUM     * Save device number characte
       DCEQ 'DS',@ARG         * DS? Disk
       BR   DSKNA1            * No
       CEQ  'K',@ARG2         * K?
       BR   ERRBA             * Error Bad Argument
       CLR  @DFLAG            * Set DSK flag
       BR   DSKNA5            * Go sub 48
DSKNA1 DCEQ 'HD',@ARG         * HD? Hard Drive   
       BR   DSKNA2            * No
       CEQ  'K',@ARG2         * K?  Hard Drive
       BS   DSKNA4            * Go set HARD flag
       BR   ERRBA             * Error Bad Argument       
DSKNA2 DCEQ 'SC',@ARG         * SC? Hard Drive
       BS   DSKNA3            * Go check S?       
       DCEQ 'WD',@ARG         * WD? Hard Drive
       BR   ERRBA             * Error Bad Argument
DSKNA3 CEQ  'S',@ARG2         * S?  Hard Drive
       DCEQ 'ID',@ARG         * ID? Hard Drive       
       BR   ERRBA             * Error Bad Argument
       CEQ  'I',@ARG2         * I? Hard Drive
       BR   ERRBA             * Error Bad Argument
DSKNA4 ST   >FF,@DFLAG        * Set SCS or WDS or HDK flag
       DST  @FAC4,@VAR5       * Get string address
       DDEC @VAR5             * Point to PATH string length
DSKNA5 SUB  48,@DEVNUM        * DSK# or SCS# or WDS# -1
       RTN
*******************************
GETFN  CALL STRGET            * Get string
       CH   10,@FAC7          * Length > 10?
       BS   ERRNTL            * Error Name Too Long
       DCZ  @FAC6             * Length = 0?
       BS   ERRBA             * Error Bad Argument
       ST   >20,V@>03C0       * Clear PATH buffer
       MOVE 31,V@>03C0,V@>03C1
       MOVE @FAC6,V*FAC4,V@>03C2 * File name
       RTN
*******************************
PATH   ST   @DEVNUM,@FAC2     * Device #
       DST  @VAR5,@FAC4       * Pathname address lenght/string
       DST  >0127,V@>03C0     * Opcode of PATHNAME subroutine
       CALL RWDSR             * Read/Write DSR LINK
       RTN                    *
*******************************
GLPARZ CEQ  LPARZ,@CHAT
       BR   ERRSYN
       RTN
STRFCH XML  PGMCHR
       XML  PARSE
       BYTE RPARZ
       RTN
STRGET CALL STRFCH
       CEQ  >65,@FAC2
       BR   ERRSNM      * STRING NUM MISMATCH
       RTN
NUMFCH CALL STRFCH
       CEQ  >65,@FAC2
       BS   ERRSNM      * STRING NUM MISMATCH
       RTN
CFIFCH XML  CFI
       CEQ  >03,@FAC+10
       BS   ERRBV       * NUMERIC OVERFLOW
       RTN
GETNUM CALL SUBLP3
       CEQ  >B3,@CHAT
       BR   ERRSYN
       RTN
NGOOD  XML  PGMCHR
       CEQ  >80,@CHAT
       BS   ERRSYN         * ?
       CALL SNDER
       CEQ  >65,@FAC2
       BR   ERRBA          * BAD ARGUMENT
       DST  >001C,@FAC
       DST  @SREF,@FAC4
       DST  @BYTES,@FAC6
       BR   SNDASS
SNDER  XML  SYM
       XML  SMB
       XML  VPUSH
       RTN
CIFSND XML  CIF
SNDASS XML  ASSGNV
       RTN
SUBLP3 CALL NUMFCH
       CALL CFIFCH
       RTN
***********************************************************
* CPU PROGRAM FOR >8300 SCATCH PAD SUBROUTINE AMSCPU      *
***********************************************************
*                 *        AORG >8300
AMSCRU DATA >8302 * CPUPGM DATA >8302      * First address.
       DATA >0420 *        BLWP @AMSCPU    * Switch contex
       DATA >830C *
       DATA >04E0 *        CLR  @>837C     * Clear for GPL
       DATA >837C *
       DATA >045B *        RT              * Return to GPL.
***********************************************************
*                 * AMS CPU SUBPROGRAM
       DATA >834A * AMSCPU DATA >834A
       DATA >8310 *        DATA AMSCRU
       DATA >020C * AMSCRU LI   R12,>1E00
       DATA >1E00 *
       DATA >1D00 *        SBO  0
       DATA >0380 *        RTWP
*                 *        END
***********************************************************
* CPU PROGRAM FOR >8300 SCRATCH PAD CPU ISR HOOK ON  *
******************************************************
*                  *        AORG >8300
GISRON DATA >8302  *        DATA >8302
       DATA >C820  *        MOV  @>834A,@>83C4
       DATA >834A  *
       DATA >83C4  *
       DATA >04E0  * EXIT   CLR  @>837C
       DATA >837C  *
       DATA >045B  *        RT
*                  *        END
***********************************************************
* CPU PROGRAM FOR >8300 SCRATCH PAD CPU ISR HOOK OFF *
******************************************************
*                          AORG >8300
GISROF DATA >8302 *        DATA >8302
       DATA >C820 * ISROFF MOV  @>83C4,@>83C4
       DATA >83C4 *
       DATA >83C4 *
       DATA >1305 *        JEQ  NHOOK
       DATA >C820 *        MOV  @>83C4,@>834A
       DATA >83C4 *
       DATA >834A *
       DATA >04E0 * NHOOK  CLR  @>83C4
       DATA >83C4 *
       DATA >04E0 *        CLR  @>837C
       DATA >837C *
       DATA >045B *        RT
*                 *        END
************************************************************

       AORG >0B00
***********************************************************
*                BASIC KEYWORD TABLE
*      THE TOKEN IS ITS LEFT BINDING POWER
***********************************************************
KEYTAB DATA CHAR1,CHAR2,CHAR3,CHAR4,CHAR5
       DATA CHAR6,CHAR7,CHAR8,CHAR9,CHARA
CHAR1  TEXT '!'
       BYTE TREMZ             *  !
       TEXT '#'
       BYTE NUMBEZ            *  #
       TEXT '&'
       BYTE CONCZ             *  &
       TEXT '('
       BYTE LPARZ             *  (
       TEXT ')'
       BYTE RPARZ             *  )
       TEXT '*'
       BYTE MULTZ             *  *
       TEXT '+'
       BYTE PLUSZ             *  +
       TEXT ','
       BYTE COMMAZ            *  ,
       TEXT '-'
       BYTE MINUSZ            *  -
       TEXT '/'
       BYTE DIVIZ             *  /
       TEXT ':'
       BYTE COLONZ            *  :
       TEXT ';'
       BYTE SEMICZ            *  ;
       TEXT '<'
       BYTE LESSZ             *  <
       TEXT '='
       BYTE EQUALZ            *  =
       TEXT '>'
       BYTE GREATZ            *  >
       TEXT '^'
       BYTE CIRCUZ            *  ^
       BYTE >FF
CHAR2  TEXT '::'
       BYTE SSEPZ             *  ::
       TEXT 'AT'
       BYTE ATZ               *  AT
       TEXT 'GO'
       BYTE GOZ               *  GO * RXB MOTION
       TEXT 'IF'
       BYTE IFZ               *  IF
       TEXT 'ON'
       BYTE ONZ               *  ON * ONKEY
       TEXT 'OR'
       BYTE ORZ               *  OR
       TEXT 'PI'
       BYTE PIZ               *  PI
       TEXT 'TO'
       BYTE TOZ               *  TO
       BYTE >FF
CHAR3  TEXT 'ABS'
       BYTE ABSZ              *  ABS
       TEXT 'ALL'
       BYTE ALLZ              *  ALL
       TEXT 'AND'
       BYTE ANDZ              *  AND
       TEXT 'ASC'
       BYTE ASCZ              *  ASC
       TEXT 'ATN'
       BYTE ATNZ              *  ATN
       TEXT 'BYE'
       BYTE >03               *  BYE
       TEXT 'CON'
       BYTE >01               *  CONtinue
       TEXT 'COS'
       BYTE COSZ              *  COS
       TEXT 'DEF'
       BYTE DEFZ              *  DEF
* GKXB added token
       TEXT 'DEL'
       BYTE >09               *  DEL
       TEXT 'DIM'
       BYTE DIMZ              *  DIM
       TEXT 'END'
       BYTE ENDZ              *  END
       TEXT 'EOF'
       BYTE EOFZ              *  EOF
       TEXT 'EXP'
       BYTE EXPZZ             *  EXP
       TEXT 'FOR'
       BYTE FORZ              *  FOR
       TEXT 'INT'
       BYTE INTZ              *  INT
       TEXT 'LEN'
       BYTE LENZ              *  LEN
       TEXT 'LET'
       BYTE LETZ              *  LET
       TEXT 'LOG'
       BYTE LOGZ              *  LOG
       TEXT 'MAX'
       BYTE MAXZ              *  MAX
       TEXT 'MIN'
       BYTE MINZ              *  MIN
       TEXT 'NEW'
       BYTE >00               *  NEW * RXB CALL NEW
       TEXT 'NOT'
       BYTE NOTZ              *  NOT
       TEXT 'NUM'
       BYTE >04               *  NUMber
       TEXT 'OLD'
       BYTE >05               *  OLD
       TEXT 'POS'
       BYTE POSZ              *  POS
       TEXT 'REC'
       BYTE RECZ              *  REC
       TEXT 'REM'
       BYTE REMZ              *  REMark
       TEXT 'RES'
       BYTE >06               *  RESequence
       TEXT 'RND'
       BYTE RNDZ              *  RND
* RXB PATCH CODE
       TEXT 'RAN'            
       BYTE RANZ              *  RAN * RXB RND
       TEXT 'RUN'
       BYTE RUNZ              *  RUN 
       TEXT 'SGN'
       BYTE SGNZZ             *  SGN
       TEXT 'SIN'
       BYTE SINZ              *  SIN
       TEXT 'SQR'
       BYTE SQRZ              *  SQR
       TEXT 'SUB'
       BYTE SUBZ              *  SUB
       TEXT 'TAB'
       BYTE TABZ              *  TAB
       TEXT 'TAN'
       BYTE TANZ              *  TAN
       TEXT 'VAL'
       BYTE VALZ              *  VAL
       TEXT 'XOR'
       BYTE XORZ              *  XOR
       BYTE >FF
CHAR4  TEXT 'BASE'
       BYTE BASEZ             *  BASE
       TEXT 'BEEP'
       BYTE BEEPZ             *  BEEP
       TEXT 'CALL'
       BYTE CALLZ             *  CALL
       TEXT 'CHR$'
       BYTE CHRZZ             *  CHR$
* GKXB added token
       TEXT 'COPY'
       BYTE >0A               *  COPY
       TEXT 'DATA'
       BYTE DATAZ             *  DATA
       TEXT 'ELSE'
       BYTE ELSEZ             *  ELSE
       TEXT 'GOTO'
       BYTE GOTOZ             *  GOTO * RXB ONKEY
       TEXT 'LIST'
       BYTE >02               *  LIST
* GKXB added token
       TEXT 'MOVE'
       BYTE >0B               *  MOVE
       TEXT 'NEXT'
       BYTE NEXTZ             *  NEXT
       TEXT 'OPEN'
       BYTE OPENZ             *  OPEN
       TEXT 'READ'
       BYTE READZ             *  READ
       TEXT 'RPT$'
       BYTE RPTZZ             *  RPT$
       TEXT 'SAVE'
       BYTE >07               *  SAVE * RXB SAVE IV254
       TEXT 'SEG$'
       BYTE SEGZZ             *  SEG$
       TEXT 'SIZE'
       BYTE SIZEZ             *  SIZE * RXB CALL SIZE
       TEXT 'STEP'
       BYTE STEPZ             *  STEP
       TEXT 'STOP'
       BYTE STOPZ             *  STOP * RXB MOTION
       TEXT 'STR$'
       BYTE STRZZ             *  STR$
       TEXT 'THEN'
       BYTE THENZ             *  THEN
       BYTE >FF
CHAR5  TEXT 'BREAK'
       BYTE BREAKZ            *  BREAK
       TEXT 'CLOSE'
       BYTE CLOSEZ            *  CLOSE
       TEXT 'DIGIT'
       BYTE DIGITZ            *  DIGIT
       TEXT 'ERASE'
       BYTE ERASEZ            *  ERASE
       TEXT 'ERROR'
       BYTE ERRORZ            *  ERROR
       TEXT 'FIXED'
       BYTE FIXEDZ            *  FIXED
       TEXT 'GOSUB'
       BYTE GOSUBZ            *  GOSUB
       TEXT 'IMAGE'
       BYTE IMAGEZ            *  IMAGE
       TEXT 'INPUT'
       BYTE INPUTZ            *  INPUT
       TEXT 'MERGE'
       BYTE >08               *  MERGE
       TEXT 'PRINT'
       BYTE PRINTZ            *  PRINT
       TEXT 'TRACE'
       BYTE TRACEZ            *  TRACE
       TEXT 'USING'
       BYTE USINGZ            *  USING
       BYTE >FF
CHAR6  TEXT 'ACCEPT'
       BYTE ACCEPZ            *  ACCEPT
       TEXT 'APPEND'
       BYTE APPENZ            *  APPEND
       TEXT 'DELETE'
       BYTE DELETZ            *  DELETE
       TEXT 'LINPUT'
       BYTE LINPUZ            *  LINPUT
       TEXT 'NUMBER'
       BYTE >04               *  NUMBER
       TEXT 'OPTION'
       BYTE OPTIOZ            *  OPTION
       TEXT 'OUTPUT'
       BYTE OUTPUZ            *  OUTPUT
       TEXT 'RETURN'
       BYTE RETURZ            *  RETURN
       TEXT 'SUBEND'
       BYTE SUBNDZ            *  SUBEND
       TEXT 'UALPHA'
       BYTE UALPHZ            *  UALPHA
       TEXT 'UPDATE'
       BYTE UPDATZ            *  UPDATE
       BYTE >FF
CHAR7  TEXT 'DISPLAY'
       BYTE DISPLZ            *  DISPLAY
       TEXT 'NUMERIC'
       BYTE NUMERZ            *  NUMERIC
       TEXT 'RESTORE'
       BYTE RESTOZ            *  RESTORE
       TEXT 'SUBEXIT'
       BYTE SUBXTZ            *  SUBEXIT
       TEXT 'UNBREAK'
       BYTE UNBREZ            *  UNBREAK
       TEXT 'UNTRACE'
       BYTE UNTRAZ            *  UNTRACE
       TEXT 'WARNING'
       BYTE WARNZ             *  WARNING
       BYTE >FF
CHAR8  TEXT 'CONTINUE'
       BYTE >01               *  CONTINUE
       TEXT 'INTERNAL'
       BYTE INTERZ            *  INTERNAL
       TEXT 'RELATIVE'
       BYTE RELATZ            *  RELATIVE
       TEXT 'VALIDATE'
       BYTE VALIDZ            *  VALIDATE
       TEXT 'VARIABLE'
       BYTE VARIAZ            *  VARIABLE
       BYTE >FF
CHAR9  TEXT 'RANDOMIZE'
       BYTE RANDOZ            *  RANDOMIZE
       BYTE >FF
CHARA  TEXT 'SEQUENTIAL'
       BYTE SEQUEZ            *  SEQUENTIAL
       BYTE >FF
***********************************************************
* RXB PATCH CODE FILLER BYTE ****************************** 
       BYTE >00,>00,>00
* GROM ADDRESS >CD77 FOR ERRTAB
***********************************************************
* ERRTAB - Error table containing all of the error messages
*          error numbers and the severity code for each
*          error. The error call number is the data byte
*          that must follow the CALL ERRZZ or CALL WARNZZ.
*          Messages with severity of zero are system
*          messages and not error messages.
*
*  Message, Error #, Severity                     CALL #
***********************************************************
ERRTAB DATA MSGFST            * "READY"
       BYTE 0,0
       DATA MSGBRK            * "BREAKPOINT"
       BYTE 0,0
       DATA MSG10             * "NUMERIC OVERFLOW"
       BYTE 10,1
       DATA MSG14             * "SYNTAX ERROR"
       BYTE 14,9
       DATA MSG16             * "ILLEGAL AFTER SUBPROGRAM"
       BYTE 16,9
       DATA MSG17             * "UNMATCHED QUOTES"
       BYTE 17,9
       DATA MSG19             * "NAME TOO LONG"
       BYTE 19,9
       DATA MSG24             * "STRING-NUMBER MISMATCH"
       BYTE 24,9
       DATA MSG25             * "OPTION BASE ERROR"
       BYTE 25,9
       DATA MSG28             * "IMPROPERLY USED NAME"
       BYTE 28,9
       DATA MSG36             * "IMAGE ERROR"
       BYTE 36,9
       DATA MSG39             * "MEMORY FULL"
       BYTE 39,9
       DATA MSG40             * "STACK OVERFLOW"
       BYTE 40,9
       DATA MSG43             * "NEXT WITHOUT FOR"
       BYTE 43,9
       DATA MSG44             * "FOR-NEXT NESTING"
       BYTE 44,9
       DATA MSG47             * "MUST BE IN SUBPROGRAM"
       BYTE 47,9
       DATA MSG48             * "RECURSIVE SUBPROGRAM CALL"
       BYTE 48,9
       DATA MSG49             * "MISSING SUBEND"
       BYTE 49,9
       DATA MSG51             * "RETURN WITHOUT GOSUB"
       BYTE 51,9
       DATA MSG54             * "STRING TRUNCATED"
       BYTE 54,1
       DATA MSG57             * "BAD SUBSCRIPT"
       BYTE 57,9
       DATA MSG56             * "SPEECH STRING TOO LONG"
       BYTE 56,9
       DATA MSG60             * "LINE NOT FOUND"
       BYTE 60,9
       DATA MSG61             * "BAD LINE NUMBER"
       BYTE 61,9
       DATA MSG62             * "LINE TOO LONG"
       BYTE 62,9
       DATA MSG67             * "CAN'T CONTINUE"
       BYTE 67,9
       DATA MSG69             * "COMMAND ILLEGAL IN PROGRAM
       BYTE 69,9
       DATA MSG70             * "ONLY LEGAL IN A PROGRAM"
       BYTE 70,9
       DATA MSG74             * "BAD ARGUMENT"
       BYTE 74,9
       DATA MSG78             * "NO PROGRAM PRESENT"
       BYTE 78,1
       DATA MSG79             * "BAD VALUE"
       BYTE 79,9
       DATA MSG81             * "INCORRECT ARGUMENT LIST"
       BYTE 81,9
       DATA MSG83             * "INPUT ERROR" (WARNING)
       BYTE 83,1
       DATA MSG84             * "DATA ERROR"
       BYTE 84,9
       DATA MSG109            * "FILE ERROR"
       BYTE 109,9
       DATA MSG130            * "I/O ERROR" (WARNING)
       BYTE 130,1
       DATA MSG130            * "I/O ERROR"
       BYTE 130,9
       DATA MSG135            * "SUBPROGRAM NOT FOUND"
       BYTE 135,9
       DATA MSG60             * "LINE NOT FOUND" (WARNING)
       BYTE 60,1
       DATA MSG97             * "PROTECTION VIOLATION"
       BYTE 97,9
       DATA MSG34             * "UNRECOGNIZED CHARACTER"
       BYTE 20,9
* Following message is added 6/24/81 for the INPUT bug.
       DATA MSG83             * "INPUT ERROR"
       BYTE 83,9
***********************************************************
* TRACBK - Is used to trace back the error levels through
*          nested function references and subprogram calls.
*          It takes care of issuing the trace back info
*          messages in these two cases. It leaves the stack
*          unchanged except in the case of a prescan error
*          occurring in an external subprogram. If any
*          messages are issued, it returns with the staus
*          set, else reset.
***********************************************************
TRACBK DST  @VSPTR,@FAC8      Get a temp stack pointer
GCE22  DCH  @STVSPT,@FAC8     While not end of stack
       BR   GCE48
       CEQ  >68,V@2(@FAC8)    If UDF entry
       BS   TRAC05
       CEQ  >70,V@2(@FAC8)    If temp UDF entry
       BR   GCE3B
       DSUB 8,@VSPTR          Trash it so DELINK won't
       BR   TRAC05             mess up the symbol table
GCE3B  CEQ  >6A,V@2(@FAC8)    If subprogram
       BS   TRAC50
       DSUB 8,@FAC8           Goto next entry on stack
       BR   GCE22
GCE48  RTN                    If no UDF or subprograms acti
* Trace back UDF reference
TRAC05 CLR  @FAC12            To cheat on ERPRNT
       EX   @PRGFLG,@FAC12    Force line # NOT to be printe
       CEQ  1,@FAC13          If warning message
       BR   GCE58
* Place for the message already set in WRNZZ3
       CALL ERPNT5            Don't restore char set
       BR   GCE5B
GCE58  CALL ERPRNT            Print the real error messgae
GCE5B  ST   @FAC12,@PRGFLG    Restore program/imperative fl
       DST  @PGMPTR,@ARG      Get the place of error for FN
       CALL FNDLNE            Find the line that the error
*                              is in
       DST  >A9AE,V@NLNADD+2  Say 'in' xx
       DST  NLNADD+5,@VARW    Start place of line number
       CALL DISO              Put out the line number
       XML  SCROLL
TRAC09 DST  V*FAC8,@ARG       Save PGMPTR from the entry
TRAC10 DSUB 8,@FAC8           Go on to next entry
       DCH  @STVSPT,@FAC8     If not end of stack
       BR   GCEE2
       CEQ  >68,V@2(@FAC8)    If function entry
       BR   GCEC8
       DCEQ @ARG,V*FAC8       If recursive
       BR   GCEB3
       MOVE 15,G@MSGCIS,V@NLNADD+2
       XML  SCROLL            * CALLS ITSELF
TRAC12 DSUB 8,@FAC8           Goto next entry on stack
GCE99  CEQ  >68,V@2(@FAC8)    While functions
       BR   GCEAC
       DCEQ @ARG,V*FAC8
       BR   TRAC09
       DSUB 8,@FAC8           Goto next entry on stack
       BR   GCE99
GCEAC  CGT  >65,V@2(@FAC8)    If string is numeric
       BR   TRAC12
GCEB3  MOVE 11,G@MSGCF,V@NLNADD+2
       CALL FNDLNE            Find the line
       DST  NLNADD+14,@VARW   Place to display it
       CALL DISO              Display the line number
       XML  SCROLL            * CALLED FROM
       BR   TRAC09            Go on
* Jump always
GCEC8  CHE  >66,V@2(@FAC8)    If not permanent
       BR   TRAC10
GCECF  DCH  VRAMVS,@FAC8      While still not at bottom
       BR   GCEE2
       CEQ  >6A,V@2(@FAC8)    If subprogram
       BS   TRAC51
       DSUB 8,@FAC8           Go down an entry
       BR   GCECF
GCEE2  CZ   @PRGFLG           If not imperative
       BS   GCEF6
       MOVE 11,G@MSGCF,V@NLNADD+2
       DST  NLNADD+14,@VARW   Place to display line #
       CALL ASC               Display it
       XML  SCROLL
GCEF6  BR   RTNSET            Return with condition set
* Trace back subprogram calls
TRAC50 CEQ  1,@FAC13          If warning message only
       BR   GCF02
       CALL ERPNT5            Don't restore char set
       BR   GCF05
GCF02  CALL ERPRNT            Print the real message
GCF05  CZ   @PRGFLG
       BS   RTNSET
TRAC51 CZ   @PRGFLG
       BS   RETNOS
       DST  >A9AE,V@NLNADD+2  Display 'IN'
       DST  NLNADD+6,@FAC12   Display location of name
TRAC55 DST  V*FAC8,@FAC16     Get S.T. pointer
       CLR  @FAC10            Need a double length
       ST   V@1(@FAC16),@FAC10+1 Get the name length
       DST  V@4(@FAC16),@FAC16   Get the name pointer
       MOVE @FAC10,V*FAC16,V*FAC12   Display
GCF2C  ADD  OFFSET,V*FAC12
       DINC @FAC12
       DDEC @FAC10
       DCZ  @FAC10
       BR   GCF2C
       XML  SCROLL            Scroll the screen 'CALLED FRO
       MOVE 11,G@MSGCF,V@NLNADD+2
       DST  @FAC8,@FAC10      In case at top level
       DST  V@6(@FAC8),@FAC8  Get LSUBP off stack
       DCZ  @FAC8             If not top level call
       BS   GCF53
       DST  NLNADD+15,@FAC12  Display location of name
       BR   TRAC55
* Now find original number
GCF53  DST  V@-6(@FAC10),@ARG2 Get pointer to line number
       CALL GETLN2            Get the actual line number
       DST  NLNADD+15,@VARW   Place to put line number
       CALL DISO              Display the line number
       XML  SCROLL            Scroll the mess up
* RETURN WITH CONDITION BIT SET
RTNSET CEQ  @>8300,@>8300     SET CONDITION BIT
RETNOS RTNC
GETLN2 DDECT @ARG2
       CALL GRSUB2            Read 2 bytes of data from ERA
       BYTE >5E             * (use GREAD1) or VDP   (>5E=AR
       DST  @EEE1,@ARG2       Put the result into @ARG2
       RTN
* Given a specific PGMPTR (in ARG) find the line number of
* the line it points into and put the actual line number
* in ARG2
FNDLNE DST  @STLN,@ARG4       Get pointer into # buffer
       DINCT @ARG4            Point at the line pointer
       DST  @ARG4,@ARG2       Get line pointer
       DCLR @ARG6             Start with a zero value
GCF7D  DCHE @ENLN,@ARG4       While in line buffer
       BS   GCF9C
       CALL GRSUB2            Get the line # from ERAM/VDP
       BYTE >60             * @ARG4: Source address on ERAM
       DCGT @ARG,@EEE1
       BS   GCF96
       DCH  @ARG6,@EEE1       If closer
       BR   GCF96
       DST  @ARG4,@ARG2       Make it the one
       DST  @EEE1,@ARG6
GCF96  DADD 4,@ARG4           Goto next line in buffer
       BR   GCF7D
GCF9C  CALL GETLN2            Get the line number
       AND  >7F,@ARG2         Reset the breakpoint if any
       RTN
***********************************************************
SPCCHR BYTE >C3,>81,>00,>00,>00,>00,>81,>C3 * DEFINE CURSOR
***********************************************************
* EDTZZ0 EQU >D000
       AORG >1000
***********************************************************
* EDIT routine - display requested line and edit any change
*                in the program segment.
*
* FAC contains the line number just read in
EDTZZ0 DCEQ @ENLN,@STLN       If no program
       BR   GD008
       B    ILLST
GD008  XML  SPEED
       BYTE SEETWO          * Try to find the line (# in FA
       BR   EDTZ08            * LINE NOT FOUND
EDTZ00 ST   29,@CCPPTR        Force new record on first lin
* The entry in the line number table is in EXTRAM
       ST   OFFSET,@DSRFLG    Set screen output mode
       ST   28,@RECLEN        Select standard record length
       DCLR @PABPTR           I/O to the screen
       CZ   @RAMTOP           If ERAM
       BS   GD020
       CALL GRMLST            Prepare to list from ERAM
GD020  CALL LLIST             List the line
* VARW contains the position of the first character followi
*      the line number.
       CH   @RECLEN,@CCPPTR   Exactly at end of line
       BR   GD032
       XML  SCROLL            Scroll up one line
       DSUB 32,@VARW          And correct both VARW
       DSUB 28,@CCPADR          and CCPADR
GD032  DST  @VARW,@ARG2       Set cursor at start position
       AND  >E0,@ARG3         Back to beginning of line
       DADD 157,@ARG2         Compute theoretically highest
       DST  @CCPADR,@VARA     Use current high position
*                              as high
       DCHE @VARA,@ARG2       If > 4 then lines-correct
       BS   GD048
       DST  >031D,@ARG2       Allow for one more line
*----------------------------------------------------------
* Fix "You cannot add characters to a line whose number is
*      multiple of 256, if that line was reached ty typing
*      either an up arrow or a down arrow from a previous
*      line" bug, the following line is changed
*      CALL READL1            Allow user to make change
GD048  CALL READL3            Allow user to make change
*----------------------------------------------------------
       CALL SAVLIN            Save the line for recall
       CZ   @RAMTOP           If ERAM exists
       BS   GD056
       DST  @FAC14,@EXTRAM     saves EXTRAM in FAC
GD056  CLOG 1,@FLAG           Autonumber
       BR   EDTZ01
       CEQ  UPARR,@RKEY       Ended in UP arrow
       BR   GD06B
       DADD 4,@EXTRAM         Point at next line to list
       DCH  @ENLN,@EXTRAM     Doesn't exist
       BS   EDTZ01
       BR   EDTZ02
GD06B  CEQ  DWNARR,@RKEY      Want next program line
       BR   GD085
       DSUB 4,@EXTRAM         Point at next line to list
       DCHE @STLN,@EXTRAM     Passed high program
       BS   EDTZ02
EDTZ01 ST   CHRTN,@RKEY       Set no more editing
       BR   GD085
EDTZ02 CALL GRSUB3            Read from  ERAM, use GREAD
*                              or VDP, Reset possible
*                              breakpoint too
       BYTE >2E             * @EXTRAM: Source address on ER
       DST  @EEE1,@ARG6       Save for general use
GD085  CZ   @ARG4             If current, the line was chan
       BR   GD0A1
       DST  CRNBUF,@RAMPTR    Initialize crunch pointer
       XML  CRUNCH            Crunch the input line
       BYTE 0               * Normal crunch mode
       DCZ  @ERRCOD           If error
       BS   GD097
       B    TOPL42
*----------------------------------------------------------
* Fix "Illegal line number 0 can be created by editting a
*      line" bug, 5/23/81
*  Add the following line, and the label TOPL55 at line
*   (TOPL45+9)
GD097  DCZ  @FAC              If line number has
       BR   GD09E              been deleted - treated as
       B    TOPL55              imperative state
*----------------------------------------------------------
GD09E  CALL EDITLN            And edit into program buffer
GD0A1  DST  @ARG6,@FAC        Line number for next line
       CEQ  CHRTN,@RKEY       Stop on carriage return
       BR   GD008
       B    TOPL15            Don't kill the symbol table
* JUMP ALWAYS
G698C  EQU  >698C
EDTZ08 B    G698C             LINE NOT FOUND
* Save input line for edit recall
SAVLIN AND  >E0,@VARW+1       Correct in case autonumber
       INCT @VARW+1           Skip edge characters
       DST  @VARA,@FAC        Get pointer to end of line
       DSUB @VARW,@FAC        Compute length of line
       BS   SAVLN5            If zero, length line
       DCH  160,@FAC          If line longer then buffer
       BR   GD0C6
       DST  160,@FAC          Default to max buffer size
* RXB PATCH CODE FIX USER / REDO KEY **********************
* GD0C6  MOVE @FAC,V*VARW,V@RECBUF  Save line
GD0C6  B    USERFG            Check for USER FLAG

       AORG >10CC 
SAVLN5 DST  @VARW,V@BUFSRT    Save pointer to line start
       DST  @VARA,V@BUFEND    Save pointer to line end
GD0D4  DCHE >0262,V@BUFSRT    If try more than 160
       BS   GD0E7
*----------------------------------------------------------
* Fix bug "Delete characters while in REDO mode, next REDO
*          still may show those deleted characters, 5/26/81
*   Replace following line
*      DST  >02FE,V@BUFEND    Update pointer to line end
       DADD 32,V@BUFEND       Shift the whole buffer 32
*                              down at a time
*----------------------------------------------------------
       DADD 32,V@BUFSRT       Update pointer for 160 chars
       BR   GD0D4
*----------------------------------------------------------
* Also add following 3 lines for the bug above
GD0E7  DCH  >02FE,V@BUFEND    Update pointer to line end
       BR   GD0F3
       DST  >02FE,V@BUFEND
*----------------------------------------------------------
GD0F3  RTN
***********************************************************
* RXB
***********************************************************
       AORG >10F4                                         *  
* AMS BRANCH TABLE FOR AMS ROUTINES  *    FIXED           *
       BR   AMSMAP                   *     AT             *
       BR   AMSPAS                   *    >D0F4           *
       BR   AMSOFF                   *  PERMANENTLY       *
       BR   AMSON                    *   ADD TO THE       *
       BR   SISRON                   *    TABLE IF        *
       BR   SISROF                   *    NEEDED.         *
***********************************************************
USERFG CZ   V@CONFLG         USER FLAG set?
       BS   NOUSR            Yes, skip ahead
       DCEQ >0900,V@>08C2    USER PAB there?
       BS   GD0F3            Yes, flag set
       BR   SAVLN5
NOUSR  MOVE @FAC,V*VARW,V@RECBUF Save line
       BR   SAVLN5           Continue       
***********************************************************
* CALL POKER(vdpr#,value)
POKER  DATA BEEP
       STRI 'POKER'           
       DATA $+2
       CALL GLPARZ
POKAGN CALL GETNUM
       DCHE 8,@FAC
       BS   ERRBV
       ST   @FAC1,@VAR0
       CALL SUBLP3
       CASE @VAR0
       BR   PREG0
       BR   PREG1
       BR   PREG2
       BR   PREG3
       BR   PREG4
       BR   PREG5
       BR   PREG6
       MOVE 1,@FAC1,#7
       BR   POKEND
PREG6  MOVE 1,@FAC1,#6
       BR   POKEND
PREG5  MOVE 1,@FAC1,#5
       BR   POKEND
PREG4  MOVE 1,@FAC1,#4
       BR   POKEND
PREG3  MOVE 1,@FAC1,#3
       BR   POKEND
PREG2  MOVE 1,@FAC1,#2
       BR   POKEND
PREG1  MOVE 1,@FAC1,#1
       BR   POKEND
PREG0  MOVE 1,@FAC1,#0
POKEND CEQ  COMMAZ,@CHAT
       BS   POKAGN
       BR   PEEK5
******************************
* CALL BEEP
BEEP   DATA HONK
       STRI 'BEEP'            
       DATA $+2
       CALL ACCTON
       BR   LDRET2
* CALL HONK
HONK   DATA DIRECT
       STRI 'HONK'            
       DATA $+2
       CALL BADTON
       BR   LDRET2
******************************
* CALL DIR(pathname)
DIRECT DATA AMAP
       STRI 'DIR'             
       DATA GKCAT
******************************
* CALL AMSMAP
AMAP   DATA APASS
       STRI 'AMSMAP'         
       DATA $+2
       CALL AMSMAP
       BR   LDRET2
AMSMAP CALL AMSSUB
       DST  >1D01,@STORE
       XML  >F0
       RTN
* CALL AMSPASS
APASS  DATA ARWOFF
       STRI 'AMSPASS'         
       DATA $+2
       CALL AMSPAS
       BR   LDRET2
AMSPAS CALL AMSSUB
       DST  >1E01,@STORE
       XML  >F0
       RTN
* CALL AMSOFF
ARWOFF DATA ARWON
       STRI 'AMSOFF'          
       DATA $+2
       CALL AMSOFF
       BR   LDRET2
AMSOFF CALL AMSSUB
       DST  >1E00,@STORE
       XML  >F0
       RTN
* CALL AMSON
ARWON  DATA ISRON
       STRI 'AMSON'              
       DATA $+2
       CALL AMSON
       BR   LDRET2
AMSON  CALL AMSSUB
       DST  >1D00,@STORE
       XML  >F0
       RTN
AMSSUB MOVE 24,G@AMSCRU,@>8300
       RTN

* CALL ISRON(variable)
ISRON  DATA ISROFF
       STRI 'ISRON'           
       DATA $+2
       CALL GLPARZ
       CALL SUBLP3
       DCZ  @FAC
       BS   ERRBV
       CALL SISRON
       BR   PEEK5
SISRON MOVE 14,G@GISRON,@>8300
       XML  >F0
       RTN
******************************************************
* CALL ISROFF(variable)
ISROFF DATA ABANK
       STRI 'ISROFF'          
       DATA $+2
       CALL GLPARZ
       CALL SISROF
       XML  PGMCHR
       DST  @FAC,@VAR0
       CALL SNDER
       CALL CLRFAC
       DST  @VAR0,@FAC
       CALL CIFSND
       BR   PEEK5
SISROF DST  @>8318,@FAC4
       MOVE 26,G@GISROF,@>8300
       XML  >F0
       DST  @FAC4,@>8318
       RTN
*****************************************************
* CALL AMSBANK(lowbank#,highbank#)
ABANK  DATA AINIT
       STRI 'AMSBANK'         
       DATA $+2
       CALL GLPARZ            * ( ?
       CALL GETNUM            * Get low page.
       DCHE 240,@FAC          * Too high?
       BS   ERRBV             * ERROR BAD VALUE.
       ADD  16,@FAC1          * Add 16 to it.
       XML  VPUSH             * Save low page.
       CALL SUBLP3            * Get high page.
       DCHE 240,@FAC          * Too high?
       BS   ERRBV             * ERROR BAD VALUE.
       ADD  16,@FAC1          * Add 16 to it.
       ST   @FAC1,@ARG1       * Save high page.
       CALL AMSMAP            * AMSMAP
       CALL AMSON             * AMSON
       XML  VPOP              * Fetch low page.
       ST   @FAC1,@ARG        * Save low page.
       ST   @>4004,@FAC       * Save old page.
       ST   @>4006,@FAC1      * Save old page 2.
       ST   @ARG,@>4004       * Load new low page.
       DST  @>2000,@FAC6      * Save new low first bytes.
       ST   @ARG,@>4006       * Duplicate new low page.
       DST  >5555,@>2000      * Write test bytes.
       DCEQ >5555,@>3000      * Did it write?
       BR   AMSERR            * No, ERROR.
       DST  @FAC6,@>2000      * Restore new low bytes.
       ST   @ARG1,@>4004      * Load new high page.
       DST  @>2000,@FAC6      * Save new high first bytes.
       ST   @ARG1,@>4006      * Duplicate new high page.
       DST  >9999,@>2000      * Write test bytes.
       DCEQ >9999,@>3000      * Did it write?
       BR   AMSERR            * No, ERROR.
       DST  @FAC6,@>2000      * Restore new high bytes.
       ST   @ARG,@>4004       * Load new low page.
       ST   @ARG1,@>4006      * Load new high page.
       CALL AMSOFF            * AMSOFF
       BR   PEEK5
*******************************
AMSERR ST   @FAC,@>4004       * Restore old page.
       ST   @FAC1,@>4006      * Restore old page 2.
       CALL AMSOFF            * AMSOFF
       XML  SCROLL
       FMT
       SCRO >60
       ROW  23
       COL  2
       HTEX '* WARNING AMS BANK ERROR *'
       FEND
       BR   ERRBV
*******************************
* CALL AMSINIT
AINIT  DATA CHRALL
       STRI 'AMSINIT'         
       DATA $+2
       CALL AMSON
       DST  >5FFE,@FAC        Start SAMS Register
       ST   >0F,@FAC2         Value to load
AINITL MOVE 1,@FAC2,@0(@FAC)  Load value in Register
       DDECT @FAC             Register address-2
       DEC  @FAC2             Value-1
       BR   AINITL            No, loop
       CALL AMSOFF
       CALL AMSMAP
       BR   LDRET2            Return to XB
*******************************
* CALL CHARSETALL
CHRALL DATA USER
       STRI 'CHARSETALL'      
       DATA $+2
       CALL CHKEND            Must be EOS now
       BR   ERRSYN            Else its an error
       ST   94,@FAC2          Number of characters
       CLR  V@>03F0           EDGE CHAR ADDRESS
       MOVE 1039,V@>03F0,V@>03F1 Clear bytes
       MOVE 8,G@SPCCHR,V@>03F0 CURSOR CHAR ADDRESS
       DST  >0408,@FAC        Start with !
       DST  CHARS,@FAC4       GROM ADDRESS
CHRLP  MOVE 7,G@0(@FAC4),V@1(@FAC) Get GROM Def
       DADD 8,@FAC            GROM ADDRESS
       DADD 7,@FAC4           VDP ADDRESS
       DEC  @FAC2             Character Count-1
       BR   CHRLP             0?
       ST   >10,V@>080F Set 1st set to black on tranparent
       MOVE 16,V@>080F,V@>0810  Ripple for rest
       BR   LDRET2            Return to XB
********************************
* CALL USER(path-string)
USER   DATA BASIC
       STRI 'USER'           
       DATA $+2
       CALL GLPARZ            PARSE UP TO "
       CALL STRGET            Get path 
       ST   >20,V@RECBUF      Clear byte
       MOVE 80,V@RECBUF,V@RECBUF+1 Ripple 80 times
       MOVE 10,G@UPAB,V@RECBUF Set up USER PAB
       ST   @FAC7,V@>08C9     Set length
       MOVE @FAC6,V*FAC4,V@>08CA Load PAB path
       ST   >FF,V@CONFLG      Set USER flag
       BR   PEEK5
UPAB   BYTE 0,>14,>09,>00,80,0,0,0,0,0
**************************************
* CALL BASIC
BASIC  DATA BSAVE
       STRI 'BASIC'           
       DATA $+2
       CALL CLSALL
GBASIC EQU  >216F
       B    GBASIC
**************************
* CALL BSAVE(pathstring)
BSAVE  DATA BLOAD
       STRI 'BSAVE'           
       DATA $+2
       CALL MYSAL             * Get pathname
       ST   >06,V@>1000       * LOAD opcode
       MOVE 8192,@>2000,V@>1020
       CALL MYDOIT            * DSRLNK opcode
       BR   PEEK5             * Done
**************************
* CALL BLOAD(pathstring)
BLOAD  DATA RENAME
       STRI 'BLOAD'           
       DATA $+2
       CALL MYSAL             * Get pathname
       ST   >05,V@>1000       * LOAD opcode
       CALL MYDOIT            * DSRLNK opcode
       MOVE 8192,V@>1020,@>2000
       BR   PEEK5             * Done
MYDOIT DST  >1009,@FAC12      * Get buffer address in VDP
       CALL LINK              * DSRLNK
       BYTE >08
       BS   ERRFE             * File Error
       CLOG >E0,V@>1001       * Set error bits
       BR   ERRFE
       RTN
MYSAL  XML  COMPCT            * GARBAGE COLLECTION
       DST  @STREND,@ARG2     * String end
       DSUB @VSPTR,@ARG2      * Value Stack PoinTeR
       DSUB 63,@ARG2          * Size of Value Stack
       DCHE >2021,@ARG2       * Size of buffer
       BR   ERRSO             * Error Stack Overflow
       CALL GLPARZ            * (
       CALL STRGET            * Pathstring
       CLR  V@>1000           * 0 BYTE
       MOVE >2020,V@>1000,V@>1001 * Ripple
       DST  >1020,V@>1002     * Buffer address
       DST  >2000,V@>1006     * Number of bytes
       ST   @FAC7,V@>1009     * Length byte
       MOVE @FAC6,V*FAC4,V@>100A * Pathstring
       RTN
******************************
* CALL RENAME(pathname,old-name,new-name)
RENAME DATA PROT
       STRI 'RENAME'          
       DATA $+2
       CALL GLPARZ            * (
RENAGN CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CZ   @DFLAG            * DSK?
       BS   RENNP             * Yes
       CALL PATH              * Set PATH
RENNP  CALL GETFN             * Old name
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL STRGET            * New name
       CH   10,@FAC7          * Length > 10?
       BS   ERRNTL            * Error Name Too Long
       MOVE @FAC6,V*FAC4,V@>03D0
       ST   @DEVNUM,@FAC2     * DSK#
       DST  >03D0,@FAC4       * New name
       DST  >03C2,@FAC6       * Old name
       CZ   @DFLAG            * DSK?
       BS   RENDSK            * Yes
       CALL DSKDSR            * DSKLNK
       DATA >0123             * Opcode RENAME HARD
       B    RENEND
RENDSK CALL DSKDSR            * DSKLNK
       DATA >0113             * Opcode RENAME DISK
RENEND CEQ  COMMAZ,@CHAT      * ,
       BS   RENAGN            * Redo again
       BR   PEEK5
*******************************
* CALL PROTECT(pathname,filename,flag)
PROT   DATA SCSI
       STRI 'PROTECT'         
       DATA $+2
       CALL GLPARZ            * (
PROAGN CALL DSKNAM            * Get pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CZ   @DFLAG            * DSK?
       BS   PRONP             * Yes
       CALL PATH              * Set PATH
PRONP  CALL GETFN             * Get filename
       CALL SUBLP3            * Option number
       CLR  @FAC3             * UNPROTECT
       DCZ  @FAC              * Unprotect?
       BS   UNPRO
       ST   >FF,@FAC3         * PROTECT
UNPRO  ST   @DEVNUM,@FAC2     * DSK#
       DST  >03C2,@FAC4       * Filename
       CZ   @DFLAG            * DSK?
       BS   PRODSK            * Yes
       CALL DSKDSR            * DSRLNK
       DATA >0122             * Opcode PROTECT HARD
       B    PROEND
PRODSK CALL DSKDSR            * DSRLNK
       DATA >0112             * Opcode PROTECT DISK
PROEND CEQ  COMMAZ,@CHAT      * ,
       BS   PROAGN            * Redo again
       BR   PEEK5
*******************************
* CALL SCSI(pathname,string-variable)
SCSI   DATA MKDIR
       STRI 'SCSI'            
       DATA $+2
       CALL GLPARZ            * (
SCSAGN CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       DST  44,@BYTES         * Length of buffer
       XML  GETSTR            * Get string space
       ST   @DEVNUM,@FAC2     * SCS#
       DST  @SREF,@FAC4       * String address
       CALL DSKDSR            * DSRLNK
       DATA >011C             * Opcode EXAMINE SCSI
       CALL NGOOD             * Assign string to variable
       CEQ  COMMAZ,@CHAT      * ,
       BS   SCSAGN            * Redo again
       BR   PEEK5
*******************************
* CALL MKDIR(pathname,directory-name)
MKDIR  DATA RMDIR
       STRI 'MKDIR'           
       DATA $+2
       DST  255,@BYTES        * For sector 0 access
       XML  GETSTR            * Get string space
       DST  @SREF,@VAR0       * Buffer address
       DDEC @VAR0             * Make it 256 byte buffer
       CALL GLPARZ            * (
MKDIR2 CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CZ   @DFLAG            * DSK?
       BR   MKDIR3            * No, Hard
       CH   5,@FAC7           * Length > 5?
       BS   ERRNTL            * Error Name Too Long
       CALL GETFN             * Filename
       ST   >FF,@FAC3         * Set to READ SECTOR
       BR   VOL1ST
VOL2ND CLR  @FAC3             * Set to WRITE SECTOR
VOL1ST DCLR @FAC              * Returned SECTOR
       ST   @DEVNUM,@FAC2     * DSK#
       DST  @VAR0,@FAC4       * Buffer Address
       DCLR @FAC6             * Sector number 0 DSK
       CALL DSKDSR            * DSRLNK
       DATA >0110             * Opcode SECTOR DISK
       MOVE 10,V@>03C2,V*VAR0 * Copy VOLUME name over old n
       CZ   @FAC3             * First pass?
       BR   VOL2ND            * No, again
       B    MKDIR4
MKDIR3 CALL PATH              * Set PATH
       CALL GETFN             * Directory name
       ST   @DEVNUM,@FAC2     * SCS#
       DST  >03C2,@FAC4       * Name address
       CALL DSKDSR            * DSRLNK
       DATA >0128             * Opcode MAKE DIRECTORY HARD
MKDIR4 CEQ  COMMAZ,@CHAT      * ,
       BS   MKDIR2            * Redo again
       BR   PEEK5
*******************************
RMDIR  DATA CUTDIR
       STRI 'RMDIR'           CALL RMDIR(pathname,directory
       DATA $+2
       CALL GLPARZ            * (
RMDIR2 CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL PATH              * Set PATH
       CALL GETFN             * Directory name
       ST   @DEVNUM,@FAC2     * SCS#
       DST  >03C2,@FAC4       * Name address
       CALL DSKDSR            * DSRLNK
       DATA >0129             * REMOVE DIRECTORY HARDDRIVE
       CEQ  COMMAZ,@CHAT      * ,
       BS   RMDIR2            * Redo again
       BR   PEEK5
*******************************
CUTDIR DATA FCOPY
       STRI 'CUTDIR'          CALL CUTDIR(pathname,director
       DATA $+2
       CALL GLPARZ            * (
CUTDI2 CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL GETFN             * Set PATH
       ST   @DEVNUM,@FAC2     * SCS#
       DST  >03C2,@FAC4       * Name address
       CALL DSKDSR            * DSRLNK
       DATA >012A             * CUT DIRECTORY HARDDRIVE
       CEQ  COMMAZ,@CHAT      * ,
       BS   CUTDI2            * Redo again
       BR   PEEK5
***********************************************************
* CALL FCOPY(pathname1,filename1,pathname2,filename2)
FCOPY  DATA SECTOR
       STRI 'FCOPY' 
       DATA $+2
       XML  COMPCT            * GARBAGE COLLECT
       DST  @STREND,@ARG2     * String end
       DSUB @VSPTR,@ARG2      * Value Stack PoinTeR address
       DSUB 63,@ARG2          * Value stack size
       DCHE >1001,@ARG2       * Buffer size
       BR   ERRSO             * Error Stack Overflow
       CALL GLPARZ            * (
FCOPY1 CLR  @VAR0             * Clear Additional info Buffe
       MOVE 12,@VAR0,@VARV    * Ripple
       CALL DSKNAM            * 1st pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       DST  @DFLAG,V@BUFSRT   * FLAG/DSK#
       DST  @VAR5,@STRPTR     * 1st pathname
       CALL GETFN             * 1st filename
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL DSKNAM            * 2nd pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       DST  @DFLAG,V@BUFEND   * FLAG/DSK#
       DST  @VAR5,@CURLIN     * 2nd pathname
       CALL STRGET            * 2nd filename
       CH   10,@FAC7          * Length > 10 ?
       BS   ERRNTL            * Error Name Too Long
       CZ   @FAC7             * Length = 0?
       BS   ERRBA             * Error Bad Argument
       MOVE @FAC6,V*FAC4,V@>03D0 * 2nd filename into buffer
       CLR  @FAC3             * ADDitional INFO ACCESS CODE
       CALL FREAD             * READ FILE HEADER
       DST  @MNUM,@SREF       * Save # of Sectors of First
       CLR  @FAC3             * ADDITIONAL INFO ACCESS CODE
       CALL FWRTE             * WRITE FILE HEADER
       DST  @SREF,@ARG        * Get Total number of Sectors
       DCLR @FAC              * Clear PASS counter
FCOPY2 DCHE 4,@ARG            * ARG>=4 Sectors?
       BS   FCOPY3            * Yes
       INC  @FAC              * PASS+1
       ST   @ARG1,@FAC1       * Save number of sectors left
       B    FCOPY4            * Done
FCOPY3 DSUB 3,@ARG            * Sectors-3
       INC  @FAC              * PASS+1
       B    FCOPY2            * Loop
FCOPY4 DST  @FAC,@SREF        * PASS/Number of sectors left
       DCLR @CURINC           * Sector Pointer
FCOPY5 CEQ  1,@SREF           * Last PASS?
       BR   FCOPY6            * No
       ST   @SREF+1,@FAC3     * # of sectors Left to read
       B    FCOPY7            * Continue
FCOPY6 ST   3,@FAC3           * 3 Sectors to read
FCOPY7 DST  @CURINC,V@>03BA   * Save SECTOR NUMBER TO USE
       DST  @CURINC,@MNUM     * SECTOR NUMBER TO USE
       CALL FREAD             * READ FILE SECTOR
       CEQ  1,@SREF           * Last PASS?
       BR   FCOPY8            * No
       ST   @SREF+1,@FAC3     * N# of sectors left to write
       B    FCOPY9            * Continue
FCOPY8 ST   3,@FAC3           * 3 Sectors to write
FCOPY9 DST  V@>03BA,@CURINC   * Get sectors to write
       DST  @CURINC,@MNUM     * SECTOR NUMBER TO USE
       CALL FWRTE             * WRITE FILE SECTOR
       DADD 3,@CURINC         * SECTOR+3
       DEC  @SREF             * PASS-1
       BR   FCOPY5            * 0=END
       CEQ  COMMAZ,@CHAT      * ,
       BS   FCOPY1            * Redo again
       BR   PEEK5
*******************************
FREAD  DST  V@BUFSRT,@DFLAG   * 1st FLAG/DSR#
       CZ   @DFLAG            * DSK?
       BS   FREAD1            * Yes
       DST  @STRPTR,@VAR5     * 1st path
       CALL PATH              * Set PATH
FREAD1 DST  >1000,@VAR0       * Buffer address in Add info
       ST   @DEVNUM,@FAC2     * DSK#
       DST  >03C2,@FAC4       * 1st filename
       CLR  @FAC6             * Pointer to Additional info
       CZ   @DFLAG            * DSK?
       BS   FREAD2            * Yes
       DST  >0124,V@>03C0     * Opcode INPUT HARD
       BR   RWDSR
FREAD2 DST  >0114,V@>03C0     * Opcode INPUT DISK
       BR   RWDSR             * DSRLNK
*******************************
FWRTE  DST  V@BUFEND,@DFLAG   * 2nd FLAG/DSK#
       CZ   @DFLAG            * DSK?
       BS   FWRTE1            * Yes
       DST  @CURLIN,@VAR5     * 2nd PATH
       CALL PATH              * Set PATH
FWRTE1 DST  >1000,@VAR0       * Buffer Address in Add info
       ST   @DEVNUM,@FAC2     * DSK#
       DST  >03D0,@FAC4       * 2nd Filename
       CLR  @FAC6             * Pointer to Add info block
       CZ   @DFLAG            * DSK#
       BS   FWRTE2            * Yes
       DST  >0125,V@>03C0     * Opcode OUTPUT HARD
       BR   RWDSR
FWRTE2 DST  >0115,V@>03C0     * Opcode OUTPUT DISK
*******************************
RWDSR  DST >03C0,@FAC12       * Buffer address
       CALL LINK              * DSRLNK
       BYTE >0A               * Subroutine
       CZ   @FAC6             * ERRORS?
       BR   ERRFE             * Yes, File Error
       RTN
*******************************
* CALL SECTOR(pathname,RWflag,#Sectors,sector-string)
SECTOR DATA >0000
       STRI 'SECTOR' 
       DATA $+2
       XML  COMPCT
       DST  @STREND,@ARG2
       DSUB @VSPTR,@ARG2
       DSUB 63,@ARG2
       DCHE 260,@ARG2
       BR   ERRSO
       CALL GLPARZ            * (
SECTOS CALL DSKNAM            * Pathname
       CEQ  COMMAZ,@CHAT      * ,
       BR   ERRSYN
       CALL GETNUM            * R/W Flag
       CLR  @VAR0             * WRITE Flag
       DCZ  @FAC              * 0000?
       BS   SECTO1
       INC  @VAR0             * READ Flag
SECTO1 CALL GETNUM            * #SECTORS
       DCZ  @FAC              * 0000?
       BS   ERRBV
       DCHE 33,@FAC           * Only 32 sectors allowed.
       BS   ERRBV
       ST   @FAC1,@VARV       * Save # SECTORS
       CALL STRGET            * SECTOR $
       DCZ  @FAC6             * 0 string length?
       BS   ERRBV
       CZ   @DFLAG            * DSK?
       BR   SECTO2            * No.
       DCHE 5,@FAC6           * String to long?
       BS   ERRBV
*********************************************************
* Maximum Drive size is 4294967295 Sectors or >FFFFFFFF *
*********************************************************
SECTO2 DCHE 9,@FAC6           * String to long HARD?
       BS   ERRBV             * Bad Value Error
       DST  @FAC6,@BYTES      * Save string length value.
       DADD @FAC6,@FAC4       * Point past end of string.
       DDEC @FAC4             * Offset to end of string.
       CLR  @FAC6             * Sector # buffer.
       MOVE 4,@FAC6,@FAC7     * Clear buffer for string.
       DST  >03C3,@ARG        * # number pointer
       CLR  V@>03C0           * Clear byte in buffer
       MOVE 4,V@>03C0,V@>03C1 * Ripple clear 4 bytes
SECTO3 CLR  @FAC
SECTO4 ST   V*FAC4,@FAC       * Get character.
       CHE  71,@FAC           * G or higher?
       BS   ERRBA
       CHE  65,@FAC           * A or higher?
       BS   SECTO5
       CHE  58,@FAC           * : or higher?
       BS   ERRBA
       CHE  48,@FAC           * 0 or higher?
       BR   ERRBA
SECTO5 SUB  48,@FAC           * - 0
       CHE  10,@FAC           * 10 or higher?
       BR   SECTO6
       SUB  >07,@FAC          * - 7
SECTO6 ST   @FAC,@FAC2        * Save nibble.
       DDEC @FAC4             * $ pointer - 1
       DDEC @BYTES            * $ length - 1
       BR   SECTO7
       ST   @FAC2,V*ARG       * Save #
       B    SECTOA            * End routine.
SECTO7 ST   V*FAC4,@FAC       * Get character.
       CHE  71,@FAC           * G or higher?
       BS   ERRBA
       CHE  65,@FAC           * A or higher?
       BS   SECTO8
       CHE  58,@FAC           * : or higher?
       BS   ERRBA
       CHE  48,@FAC           * 0 or higher?
       BR   ERRBA
SECTO8 SUB  48,@FAC           * - 0
       CHE  10,@FAC           * 10 or higher?
       BR   SECTO9
       SUB  >07,@FAC          * - 7
SECTO9 SLL  4,@FAC            * Swap nibbles.
       ADD  @FAC2,@FAC        * Add old nibble.
       ST   @FAC,V*ARG        * Save #
       DDEC @ARG              * # pointer - 1
       DDEC @FAC4             * $ pointer - 1
       DDEC @BYTES            * $ length - 1
       BR   SECTO3
SECTOA MOVE 4,V@>03C0,@FAC6   * Get SECTOR # string
       DEX  @FAC8,@FAC6       * SWAP FAC6 with FAC8
       CZ   @DFLAG            * DSK?
       BR   SECTOB            * No.
       DST  @FAC8,@FAC6       * DISK
SECTOB DCLR @SREF             * CPU BUFFER
SECTOC DCLR @FAC              * Clear Returned Sector.
       ST   @DEVNUM,@FAC2     * UNIT#
       ST   @VAR0,@FAC3       * R/W Flag.
       DST  >1000,@FAC4       * VDP BUFFER
       CZ   @DFLAG            * DSK?
       BS   SECTOD            * Yes.
       DST  >0120,V@>03C0     * HARD
       BR    SECTOE
SECTOD DST  >0110,V@>03C0     * DISK
SECTOE CZ   @VAR0             * WRITE FLAG?
       BR   SECT0F            * NO
       MOVE 256,@>2000(@SREF),V@>1000  * WRITE CPU BUFFER
SECT0F CALL RWDSR             * DSR Access.
       CZ   @VAR0             * WRITE FLAG?
       BS   SECWRT            * YES
       MOVE 256,V@>1000,@>2000(@SREF)  * READ VDP BUFFER
SECWRT DADD 256,@SREF         * CPU BUFFER + 256
       CZ   @DFLAG            * DSK?
       BS   SECTOH            * Yes.
       DCEQ >FFFF,@FAC6       * Overflow one word?
       BS   SECTOG            * Yes.
       BR   SECTOH            * No.
SECTOG DCLR @FAC6             * HARD LOW BYTE=0000
       DINC @FAC8             * HARD HIGH BYTE + 1
       BR   SECTOI            
SECTOH DINC @FAC6             * SECTOR# + 1 DISK & HARD
SECTOI DEC  @VARV             * #SECTORS - 1
       BR   SECTOC
       CEQ  COMMAZ,@CHAT      * ,?
       BS   SECTOS            * Repeat.
       BR   PEEK5
***********************************************************
* EDITOR ASSEMBLER LOWER 8K SUPPORT
* Data for Initialization of
* Memory Expansion
*
LOW1  DATA  >A55A,>2128,>2398,>225A
LOW2  DATA  >A000,>FFD7,>2676,>3F38
LOW3  DATA  >0064,>2000,>2EAA,>2094
      DATA  >21C4,>2094,>2196,>2094,>21DE,>2094,>21F4
      DATA  >2094,>2200,>2094,>220E,>2094,>221A,>2094,>2228
      DATA  >209A,>22B2,>20DA,>23BA,>C80B,>2030,>D060
      DATA  >8349,>2060,>20FC,>132A,>C020,>8350,>1311,>06A0
      DATA  >2646,>101E,>0281,>3F38,>1319,>C001,>0202
      DATA  >834A,>8CB0,>1611,>8CB0,>160F,>8CB0,>160D,>C810
      DATA  >2022,>02E0,>20BA,>C020,>2022,>1309,>0690
      DATA  >02E0,>83E0,>C2E0,>2030,>045B,>0221,>0008,>10E4
      DATA  >0200,>0F00,>D800,>8322,>02E0,>83E0,>0460
      DATA  >00CE,>5820,>20FC,>8349,>02E0,>2094,>0380,>C83E
      DATA  >83E2,>02E0,>83E0,>C80B,>20AA,>C081,>0281
      DATA  >8000,>1B07,>09C1,>0A11,>0A42,>09B2,>A0A1,>0CFA
      DATA  >C092,>0692,>02E0,>2094,>C80B,>83F6,>0380
      DATA  >D060,>8373,>0981,>C87E,>8304,>F820,>20FC,>8349
      DATA  >02E0,>83E0,>C2E0,>2030,>045B,>02E0,>83E0
      DATA  >C80B,>20AA,>06A0,>000E,>02E0,>2094,>C80B,>83F6
      DATA  >0380,>06A0,>223A,>D82D,>0002,>8C00,>0380
      DATA  >06A0,>223A,>D831,>8C00,>0602,>16FC,>0380,>06A0
      DATA  >2240,>DB60,>8800,>0002,>0380,>06A0,>2240
      DATA  >DC60,>8800,>0602,>16FC,>0380,>C05D,>D82D,>0001
      DATA  >8C02,>0261,>8000,>D801,>8C02,>0380,>0201
      DATA  >4000,>1001,>04C1,>C09D,>D820,>2099,>8C02,>E081
      DATA  >D802,>8C02,>C06D,>0002,>C0AD,>0004,>045B
      DATA  >0204,>834A,>C014,>C184,>04F6,>04F6,>C140,>1323
      DATA  >0740,>0203,>0040,>04F6,>04D6,>0280,>0064
      DATA  >1A13,>0280,>2710,>1A08,>0583,>C040,>04C0,>3C20
      DATA  >20FA,>D920,>83E3,>0003,>0583,>C040,>04C0
      DATA  >3C20,>20FA,>D920,>83E3,>0002,>D920,>83E1,>0001
      DATA  >D520,>83E7,>0545,>1101,>0514,>045B,>C17E
      DATA  >53E0,>20FC,>C020,>8356,>C240,>0229,>FFF8,>0420
      DATA  >2114,>D0C1,>0983,>0704,>0202,>208C,>0580
      DATA  >0584,>80C4,>1306,>0420,>2114,>DC81,>9801,>20FE
      DATA  >16F6,>C104,>1352,>0284,>0007,>154F,>04E0
      DATA  >83D0,>C804,>8354,>C804,>2036,>0584,>A804,>8356
      DATA  >C820,>8356,>2038,>02E0,>83E0,>04C1,>020C
      DATA  >0F00,>C30C,>1301,>1E00,>022C,>0100,>04E0,>83D0
      DATA  >028C,>2000,>1332,>C80C,>83D0,>1D00,>0202
      DATA  >4000,>9812,>20FF,>16EE,>A0A0,>20A4,>1003,>C0A0
      DATA  >83D2,>1D00,>C092,>13E6,>C802,>83D2,>05C2
      DATA  >C272,>D160,>8355,>1309,>9C85,>16F2,>0985,>0206
      DATA  >208C,>9CB6,>16ED,>0605,>16FC,>0581,>C801
      DATA  >203A,>C809,>2034,>C80C,>2032,>0699,>10E2,>1E00
      DATA  >02E0,>209A,>C009,>0420,>2114,>09D1,>1604
      DATA  >0380,>02E0,>209A,>04C1,>06C1,>D741,>F3E0,>20FC
      DATA  >0380,>C80B,>2030,>02E0,>20BA,>0420,>2124
      DATA  >02E0,>83E0,>1303,>C2E0,>2030,>045B,>D820,>20BA
      DATA  >8322,>0460,>00CE,>04E0,>2022,>53E0,>20FC
      DATA  >C020,>8356,>0420,>2120,>0008,>1332,>0220,>FFF7
      DATA  >0201,>0200,>0420,>210C,>0580,>C800,>202E
      DATA  >C1E0,>2024,>C147,>04CC,>06A0,>25E0,>0283,>0001
      DATA  >1624,>058C,>04C3,>1023,>0283,>0046,>161E
      DATA  >04C2,>06A0,>262E,>0283,>003A,>16F7,>C020,>202E
      DATA  >0600,>0201,>0100,>0420,>210C,>06A0,>25E0
      DATA  >C020,>2022,>1307,>06A0,>2646,>1005,>CB4E,>0016
      DATA  >C3A0,>2022,>0380,>D740,>F3E0,>20FC,>0380
      DATA  >06A0,>25C2,>04C4,>D123,>2662,>0974,>C808,>202C
      DATA  >06A0,>2594,>0464,>23F8,>0580,>0240,>FFFE
      DATA  >C120,>2024,>A100,>1808,>8804,>2026,>1B05,>C160
      DATA  >2024,>C804,>2024,>100A,>C120,>2028,>A100
      DATA  >8804,>202A,>140C,>C160,>2028,>C804,>2028,>C1C5
      DATA  >0209,>0008,>06A0,>262E,>0609,>16FC,>10B6
      DATA  >0200,>0800,>10CC,>A005,>C800,>2022,>10AF,>A800
      DATA  >202C,>13AC,>0200,>0B00,>10C2,>A005,>C1C0
      DATA  >10A6,>A005,>DDC0,>DDE0,>20DB,>10A1,>A005,>06A0
      DATA  >2566,>C000,>1316,>0226,>FFF8,>8106,>1B02
      DATA  >0514,>1096,>8594,>16F8,>89A4,>0002,>0002,>16F4
      DATA  >89A4,>0004,>0004,>16F0,>C0E6,>0006,>C250
      DATA  >C403,>C009,>16FC,>0224,>0008,>C804,>202A,>10EA
      DATA  >A005,>06A0,>2566,>0226,>FFF8,>8106,>13E3
      DATA  >C296,>1501,>050A,>8294,>16F7,>89A4,>0002,>0002
      DATA  >16F3,>89A4,>0004,>0004,>16EF,>C296,>1516
      DATA  >C0E6,>0006,>C253,>C4C0,>C0C9,>16FC,>C246,>6244
      DATA  >C286,>022A,>0008,>C0C6,>0643,>064A,>C693
      DATA  >0649,>16FB,>0224,>0008,>C804,>202A,>10D9,>CB44
      DATA  >0002,>0200,>0C00,>0460,>2432,>0460,>2494
      DATA  >C28B,>0209,>0006,>C1A0,>202A,>0226,>FFF8,>C106
      DATA  >8806,>2028,>1AF3,>C806,>202A,>06A0,>262E
      DATA  >DDA0,>20E1,>0609,>16FA,>C580,>0206,>4000,>045A
      DATA  >C28B,>04C0,>C30C,>1308,>06A0,>262E,>D020
      DATA  >20E1,>06A0,>262E,>A003,>045A,>0209,>0004,>06A0
      DATA  >262E,>06A0,>25C2,>0A40,>A003,>0609,>16F8
      DATA  >045A,>0223,>FFD0,>0283,>000A,>1A05,>0223,>FFF9
      DATA  >0283,>0019,>1B01,>045B,>0200,>0A00,>0460
      DATA  >2432,>02E0,>83E0,>0200,>2032,>C330,>C270,>C830
      DATA  >8354,>C830,>8356,>C050,>1D00,>9820,>4000
      DATA  >20FF,>161D,>0699,>101B,>1E00,>02E0,>20DA,>C020
      DATA  >202E,>0201,>20DB,>0202,>0004,>0420,>2118
      DATA  >7000,>0950,>1610,>0982,>C001,>0201,>203C,>0420
      DATA  >2118,>04C8,>0602,>11D7,>D0F1,>0983,>A203
      DATA  >045B,>02E0,>20DA,>04C0,>06C0,>0460,>2432,>0201
      DATA  >3F40,>0221,>FFF8,>C011,>1105,>8060,>202A
      DATA  >16F9,>05CB,>045B,>0200,>0D00,>045B,>2D52,>5163
      DATA  >6483,>8455,>045C,>5B5F,>5EF0,>F003,>F0F0
      DATA  >4700,>00C8,>3F38
LOW4  DATA  >5554,>4C54,>4142,>2022,>5041,>4420,>2020,>8300
      DATA  >4750,>4C57,>5320,>83E0,>534F,>554E,>4420
      DATA  >8400,>5644,>5052,>4420,>8800,>5644,>5053,>5441
      DATA  >8802,>5644,>5057,>4420,>8C00,>5644,>5057
      DATA  >4120,>8C02,>5350,>4348,>5244,>9000,>5350,>4348
      DATA  >5754,>9400,>4752,>4D52,>4420,>9800,>4752
      DATA  >4D52,>4120,>9802,>4752,>4D57,>4420,>9C00,>4752
      DATA  >4D57,>4120,>9C02,>5343,>414E,>2020,>000E
      DATA  >584D,>4C4C,>4E4B,>2104,>4B53,>4341,>4E20,>2108
      DATA  >5653,>4257,>2020,>210C,>564D,>4257,>2020
      DATA  >2110,>5653,>4252,>2020,>2114,>564D,>4252,>2020
      DATA  >2118,>5657,>5452,>2020,>211C,>4453,>524C
      DATA  >4E4B,>2120,>4C4F,>4144,>4552,>2124,>4750,>4C4C
      DATA ,>4E4B,>2100
********************************************************************************
